AHIOIG01 ;NC/RLP Data Extract for OIG from File 442 01-Jul-02 ; T1 D VARS S TABLE="PURCHASE ORDER" D DEV G EXIT T2 D VARS S TABLE="ITEM DESCRIPTION" D DEV G EXIT ; DEV K IO("Q") S %ZIS("B")="NETSERVER" D ^%ZIS I POP G EXIT ; U IO S StrtDate=2991000 ; 00-Oct-01 S EndDate=3020331 ; 31-Mar-02 ; MAIN S PODate=StrtDate F S PODate=$O(^PRC(442,"AB",PODate)) Q:'PODate!(PODate>EndDate) D ; . S IEN=0 . F S IEN=$O(^PRC(442,"AB",PODate,IEN)) Q:'IEN D ; . . I $D(^PRC(442,IEN,7)) S SplyStat=+$P(^(7),"^",2) D ; . . . I SplyStat'<20,(SplyStat'>44) D ; . . . . ; . . . . ; --- Lets get the common data --- NODE0 . . . . S Node0=^PRC(442,IEN,0) . . . . S PONumber=$P(Node0,"^",1) . . . . ; S PODateEx=$$FMTE^XLFDT(PODate,2) . . . . S PODateEx=$$ENTRY^RGUTDT(PODate,"0000") . . . . S SplyStNm=$S($D(^PRCD(442.3,SplyStat,0)):$P(^(0),"^",1),1:"No S upply Status") . . . . ; . . . . ; --- Decide which table for output --- . . . . I TABLE="PURCHASE ORDER" D TBL1 . . . . I TABLE="ITEM DESCRIPTION" D TBL2 Q ; EXIT D VARS,^%ZISC Q ; VARS K %ZIS("B"),AuthByer,BOC,ByerExt,Descrptn,EndDate,FCP,IEN,LoopDesc K LoopItem,Node0,Node1,NodeItem,PODate,PONumber,PckgMult,PckgUnit K PckgUnit,ReqstSrv,SplyStat,StockNum,StrtDate,TABLE,TotalAmt K UnitCost,Vendor Q ; ; ; TBL1 S FCP=$P(Node0,"^",3) S TotalAmt=$P(Node0,"^",15) ; NODE1 S Node1=^PRC(442,IEN,1) S Vendor=$S($D(^PRC(440,+$P(Node1,"^",1),0)):$P(^(0),"^",1),1:"No Vendor ") S ReqstSrv=$S($D(^DIC(49,+$P(Node1,"^",2),0)):$P(^(0),"^",1),1:"No Reque sting Service") S AuthByer="" I $D(^VA(200,+$P(Node1,"^",10),0)) D ; . S AuthByer=$P(^(0),"^",1) S ByerExt="" I $D(^VA(200,+$P(Node1,"^",10),.13)) D ; . S ByerExt=$P(^(.13),"^",2) ; W !,IEN,"^",PONumber,"^",PODateEx,"^",SplyStNm,"^",FCP,"^",TotalAmt,"^" W Vendor,"^",ReqstSrv,"^",AuthByer,"^",ByerExt,"^" Q ; ; TBL2 S LoopItem=0 F S LoopItem=$O(^PRC(442,IEN,2,LoopItem)) Q:'LoopItem D ; . ; . ; --- Lets get the purchased item data --- . S NodeItem=^PRC(442,IEN,2,LoopItem,0) . S Quantity=$P(NodeItem,"^",2) . S PckgUnit="" I $D(^PRCD(420.5,+$P(NodeItem,"^",3),0)) D ; . . S PckgUnit=$P(^(0),"^",2) . S BOC=$P(NodeItem,"^",4) . S StockNum=$P(NodeItem,"^",6) . S UnitCost=$P(NodeItem,"^",9) D ; . . I UnitCost']"" S UnitCost=0 . . I UnitCost["N/C" S UnitCost=0 . S PckgMult=$P(NodeItem,"^",12) . ; . S LoopDesc=0 . F S LoopDesc=$O(^PRC(442,IEN,2,LoopItem,1,LoopDesc)) Q:'LoopDesc D ; . . S Descrptn=^PRC(442,IEN,2,LoopItem,1,LoopDesc,0) . . S Descrptn=$TR(Descrptn,"^","*") . . ; . . W !,IEN,"^",PONumber,"^",PODateEx,"^",SplyStNm,"^" . . W LoopItem,"^",LoopDesc,"^",Descrptn,"^" . . W BOC,"^",StockNum,"^",UnitCost,"^",Quantity,"^",PckgUnit,"^" . . W PckgMult,"^" Q