- ACRFPOL ;IHS/OIRM/DSD/THL,AEF - PURCHASE ORDER LOG; [ 09/23/2005 9:44 AM ]
- ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
- EN D EXIT
- D EN1
- EXIT K ACROUT,ACRQUIT,ACRDA,ACRPODA,ACRFY,^TMP("ACRPOL",$J),ACRPA,ACRPAX,ACRBEG,ACRBEGIN,ACREND,ACRDOCDA,ACRDOC0,ACRDOC,ACRSORT,ACRSSTOT,ACRTOT,ACRRTN,ACRV,ACRDOCX,ACRCANCL
- Q
- EN1 ;
- D OFFICE^ACRFPA
- Q:'+$G(ACRDA)
- S ACRPODA=ACRDA
- W !
- D DATES^ACRFDATE
- Q:'$D(ACRBEGIN)
- D PA
- Q:$D(ACRQUIT)!$D(ACROUT)
- D SORT
- Q:$D(ACRQUIT)!$D(ACROUT)
- D CANCEL
- Q:$D(ACRQUIT)!$D(ACROUT)
- D ZIS
- Q
- ZIS S ACRRTN="LOG^ACRFPOL"
- S ZTDESC="PURCHASE ORDER LOG"
- D ^ACRFZIS
- Q
- LOG ;EP;TO PRINT PURCHASE ORDER LOG
- S ACRBEG=ACRBEGIN
- F S ACRBEG=$O(^ACRDOC("S",ACRBEG)) Q:'ACRBEG!(ACRBEG>ACREND) D
- .S ACRDOCDA=0
- .F S ACRDOCDA=$O(^ACRDOC("S",ACRBEG,ACRDOCDA)) Q:'ACRDOCDA D
- ..S ACRDOC0=^ACRDOC(ACRDOCDA,0)
- ..Q:$E($P(ACRDOC0,U,2),1,8)'?8N
- ..Q:ACRPODA'=$P(ACRDOC0,U,8)
- ..I $D(ACRCANCL),$P(ACRDOC0,U,14)'["CANCEL" Q
- ..I ACRPA(1),ACRPA(1)'=+$G(^ACRDOC(ACRDOCDA,"PA")) Q
- ..I ACRPA(1)="EACH" D
- ...S ACRPA=+$G(^ACRDOC(ACRDOCDA,"PA"))
- ...;S:ACRPA ACRPA=$P(^VA(200,ACRPA,0),U) ;ACR*2.1*19.02 IM16848
- ...S:ACRPA ACRPA=$$NAME2^ACRFUTL1(ACRPA) ;ACR*2.1*19.02 IM16848
- ..S ACRDOC=$S(ACRSORT=1:$P(ACRDOC0,U,2),ACRSORT=2:$P(ACRDOC0,U),1:+$P($G(^ACRDOC(ACRDOCDA,"PO")),U,5))
- ..I ACRSORT=3 D
- ...S ACRDOC=$P($G(^AUTTVNDR(+ACRDOC,0)),U)
- ...S:ACRDOC="" ACRDOC="NOT STATED"
- ..I ACRPA]"",ACRDOC]"",ACRDOCDA]"" S ^TMP("ACRPOL",$J,ACRPA,ACRDOC,ACRDOCDA)=""
- Q:'$D(^TMP("ACRPOL",$J))
- D HEAD
- S (ACRPAX,ACRPA)=""
- F S ACRPA=$O(^TMP("ACRPOL",$J,ACRPA)) Q:ACRPA=""!$D(ACROUT)!$D(ACRQUIT) D
- .I ACRPAX'=ACRPA D
- ..W !?10,"PURCHASING AGENT: ",$S($L(ACRPA)>1:ACRPA,1:"NOT STATED")
- ..S ACRPAX=ACRPA
- ..S ACRJ=0
- .S (ACRDOCX,ACRDOC)=""
- .F S ACRDOC=$O(^TMP("ACRPOL",$J,ACRPA,ACRDOC)) Q:ACRDOC=""!$D(ACROUT)!$D(ACRQUIT) D DISPLAY
- .W !?15,"Total PURCHASE ORDERS: ",ACRJ
- D PAUSE^ACRFWARN
- Q
- DISPLAY ;DIPLAY EACH PO
- I ACRSORT=3 D
- .I ACRDOCX]"",ACRDOCX'=ACRDOC D I 1
- ..W !?66,"-------------"
- ..W !?50,"VENDOR TOTAL: ",?66,$J($FN(ACRV(ACRDOCX),"P,",2),13)
- ..W $$DASH^ACRFMENU
- ..K ACRV(ACRDOC)
- ..S ACRDOCX=ACRDOC
- .E S ACRDOCX=ACRDOC
- S ACRJ=ACRJ+1
- S ACRDOCDA=0
- F S ACRDOCDA=$O(^TMP("ACRPOL",$J,ACRPA,ACRDOC,ACRDOCDA)) Q:'ACRDOCDA!$D(ACROUT)!$D(ACRQUIT) D
- .K DXS,DIP,DC,DN,D0
- .S D0=ACRDOCDA
- .S N(1)=""
- .D ^ACRPOL
- .I $Y+4>IOSL D
- ..D PAUSE^ACRFWARN
- ..D:'$D(ACRQUIT) HEAD
- Q
- PA ;EP;
- S DIR(0)="SO^1:DO NOT Print by Purchasing Agent;2:Print for ALL Purchasing Agents;3:Print for ONE Purchasing Agent"
- W !
- D DIR^ACRFDIC
- Q:$D(ACRQUIT)!$D(ACROUT)
- I Y=1 D Q
- .S ACRPA(1)="ALL"
- .S ACRPA="ALL"
- I Y=2 S ACRPA(1)="EACH" Q
- S DIC="^ACRPA("
- S DIC("A")="Which PURCHASING AGENT: "
- S DIC(0)="AEMQZ"
- W !
- D DIC^ACRFDIC
- Q:$D(ACRQUIT)!$D(ACROUT)
- S (ACRPA,ACRPA(1))=+Y
- ;S:$D(^VA(200,+ACRPA,0)) ACRPA=$P(^(0),U) ;ACR*2.1*19.02 IM16848
- S:$D(^VA(200,+ACRPA,0)) ACRPA=$$NAME2^ACRFUTL1(+ACRPA) ;ACR*2.1*19.02 IM16848
- Q
- SORT ;SET THE LIST SEQUENCE BY PO OR REQ NUMBER
- S DIR(0)="SO^1:List by PO Number;2:List by Requisition Number;3:List by Vendor"
- S DIR("A")="Which sequence"
- S DIR("B")=1
- W !
- D DIR^ACRFDIC
- Q:$D(ACROUT)!$D(ACRQUIT)!($G(Y)<1)
- S ACRSORT=+Y
- Q
- HEAD ;HEADER
- W @IOF
- W !?10,"PURCHASE ORDER LOG"
- W ?55,"REPORT DATE: "
- S Y=DT
- X ^DD("DD")
- W Y
- W !?10,"ORDERS FROM: "
- S Y=ACRBEGIN
- X ^DD("DD")
- W Y
- S ACRI=$G(ACRI)+1
- W ?55,"PAGE.......: ",ACRI
- W !?10,"ORDERS TO..: "
- S Y=ACREND
- X ^DD("DD")
- W Y
- W:ACRI=1 !?10,"('*' indicates CANCELLED Purchase Orders)"
- W !?34,"DATE OF"
- W !,"PO NUMBER"
- W ?15,"REQUISITION NO."
- W ?34,"ORDER"
- W ?44,"CONTRACTOR"
- W ?66,"AMOUNT"
- W !,"-------------"
- W ?15,"---------------"
- W ?34,"--------"
- W ?44,"--------------------"
- W ?66,"-------------"
- Q
- SSTOT ;EP;TO CALCULATE AND PRINT THE PO TOTAL ON THE PO LOG LISTING
- N ACR
- S ACRSSTOT=0
- S ACR=ACRDOCDA
- D SSTOT^ACRFWARN
- W:$G(ACRSSTOT) $J($FN(ACRSSTOT,"P,",2),13)
- I ACRSORT=3 S ACRV(ACRDOC)=$G(ACRV(ACRDOC))+ACRSSTOT
- Q
- CANCEL ;PRINT CANCELLED PO'S ONLY
- K ACRCANCL
- S DIR(0)="YO"
- S DIR("A")="Print CANCELLED PO's only"
- S DIR("B")="NO"
- W !
- D DIR^ACRFDIC
- I +Y=1 S ACRCANCL=""
- Q
- ACRFPOL ;IHS/OIRM/DSD/THL,AEF - PURCHASE ORDER LOG; [ 09/23/2005 9:44 AM ]
- +1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
- EN DO EXIT
- +1 DO EN1
- EXIT KILL ACROUT,ACRQUIT,ACRDA,ACRPODA,ACRFY,^TMP("ACRPOL",$JOB),ACRPA,ACRPAX,ACRBEG,ACRBEGIN,ACREND,ACRDOCDA,ACRDOC0,ACRDOC,ACRSORT,ACRSSTOT,ACRTOT,ACRRTN,ACRV,ACRDOCX,ACRCANCL
- +1 QUIT
- EN1 ;
- +1 DO OFFICE^ACRFPA
- +2 IF '+$GET(ACRDA)
- QUIT
- +3 SET ACRPODA=ACRDA
- +4 WRITE !
- +5 DO DATES^ACRFDATE
- +6 IF '$DATA(ACRBEGIN)
- QUIT
- +7 DO PA
- +8 IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +9 DO SORT
- +10 IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +11 DO CANCEL
- +12 IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +13 DO ZIS
- +14 QUIT
- ZIS SET ACRRTN="LOG^ACRFPOL"
- +1 SET ZTDESC="PURCHASE ORDER LOG"
- +2 DO ^ACRFZIS
- +3 QUIT
- LOG ;EP;TO PRINT PURCHASE ORDER LOG
- +1 SET ACRBEG=ACRBEGIN
- +2 FOR
- SET ACRBEG=$ORDER(^ACRDOC("S",ACRBEG))
- IF 'ACRBEG!(ACRBEG>ACREND)
- QUIT
- Begin DoDot:1
- +3 SET ACRDOCDA=0
- +4 FOR
- SET ACRDOCDA=$ORDER(^ACRDOC("S",ACRBEG,ACRDOCDA))
- IF 'ACRDOCDA
- QUIT
- Begin DoDot:2
- +5 SET ACRDOC0=^ACRDOC(ACRDOCDA,0)
- +6 IF $EXTRACT($PIECE(ACRDOC0,U,2),1,8)'?8N
- QUIT
- +7 IF ACRPODA'=$PIECE(ACRDOC0,U,8)
- QUIT
- +8 IF $DATA(ACRCANCL)
- IF $PIECE(ACRDOC0,U,14)'["CANCEL"
- QUIT
- +9 IF ACRPA(1)
- IF ACRPA(1)'=+$GET(^ACRDOC(ACRDOCDA,"PA"))
- QUIT
- +10 IF ACRPA(1)="EACH"
- Begin DoDot:3
- +11 SET ACRPA=+$GET(^ACRDOC(ACRDOCDA,"PA"))
- +12 ;S:ACRPA ACRPA=$P(^VA(200,ACRPA,0),U) ;ACR*2.1*19.02 IM16848
- +13 ;ACR*2.1*19.02 IM16848
- IF ACRPA
- SET ACRPA=$$NAME2^ACRFUTL1(ACRPA)
- End DoDot:3
- +14 SET ACRDOC=$SELECT(ACRSORT=1:$PIECE(ACRDOC0,U,2),ACRSORT=2:$PIECE(ACRDOC0,U),1:+$PIECE($GET(^ACRDOC(ACRDOCDA,"PO")),U,5))
- +15 IF ACRSORT=3
- Begin DoDot:3
- +16 SET ACRDOC=$PIECE($GET(^AUTTVNDR(+ACRDOC,0)),U)
- +17 IF ACRDOC=""
- SET ACRDOC="NOT STATED"
- End DoDot:3
- +18 IF ACRPA]""
- IF ACRDOC]""
- IF ACRDOCDA]""
- SET ^TMP("ACRPOL",$JOB,ACRPA,ACRDOC,ACRDOCDA)=""
- End DoDot:2
- End DoDot:1
- +19 IF '$DATA(^TMP("ACRPOL",$JOB))
- QUIT
- +20 DO HEAD
- +21 SET (ACRPAX,ACRPA)=""
- +22 FOR
- SET ACRPA=$ORDER(^TMP("ACRPOL",$JOB,ACRPA))
- IF ACRPA=""!$DATA(ACROUT)!$DATA(ACRQUIT)
- QUIT
- Begin DoDot:1
- +23 IF ACRPAX'=ACRPA
- Begin DoDot:2
- +24 WRITE !?10,"PURCHASING AGENT: ",$SELECT($LENGTH(ACRPA)>1:ACRPA,1:"NOT STATED")
- +25 SET ACRPAX=ACRPA
- +26 SET ACRJ=0
- End DoDot:2
- +27 SET (ACRDOCX,ACRDOC)=""
- +28 FOR
- SET ACRDOC=$ORDER(^TMP("ACRPOL",$JOB,ACRPA,ACRDOC))
- IF ACRDOC=""!$DATA(ACROUT)!$DATA(ACRQUIT)
- QUIT
- DO DISPLAY
- +29 WRITE !?15,"Total PURCHASE ORDERS: ",ACRJ
- End DoDot:1
- +30 DO PAUSE^ACRFWARN
- +31 QUIT
- DISPLAY ;DIPLAY EACH PO
- +1 IF ACRSORT=3
- Begin DoDot:1
- +2 IF ACRDOCX]""
- IF ACRDOCX'=ACRDOC
- Begin DoDot:2
- +3 WRITE !?66,"-------------"
- +4 WRITE !?50,"VENDOR TOTAL: ",?66,$JUSTIFY($FNUMBER(ACRV(ACRDOCX),"P,",2),13)
- +5 WRITE $$DASH^ACRFMENU
- +6 KILL ACRV(ACRDOC)
- +7 SET ACRDOCX=ACRDOC
- End DoDot:2
- IF 1
- +8 IF '$TEST
- SET ACRDOCX=ACRDOC
- End DoDot:1
- +9 SET ACRJ=ACRJ+1
- +10 SET ACRDOCDA=0
- +11 FOR
- SET ACRDOCDA=$ORDER(^TMP("ACRPOL",$JOB,ACRPA,ACRDOC,ACRDOCDA))
- IF 'ACRDOCDA!$DATA(ACROUT)!$DATA(ACRQUIT)
- QUIT
- Begin DoDot:1
- +12 KILL DXS,DIP,DC,DN,D0
- +13 SET D0=ACRDOCDA
- +14 SET N(1)=""
- +15 DO ^ACRPOL
- +16 IF $Y+4>IOSL
- Begin DoDot:2
- +17 DO PAUSE^ACRFWARN
- +18 IF '$DATA(ACRQUIT)
- DO HEAD
- End DoDot:2
- End DoDot:1
- +19 QUIT
- PA ;EP;
- +1 SET DIR(0)="SO^1:DO NOT Print by Purchasing Agent;2:Print for ALL Purchasing Agents;3:Print for ONE Purchasing Agent"
- +2 WRITE !
- +3 DO DIR^ACRFDIC
- +4 IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +5 IF Y=1
- Begin DoDot:1
- +6 SET ACRPA(1)="ALL"
- +7 SET ACRPA="ALL"
- End DoDot:1
- QUIT
- +8 IF Y=2
- SET ACRPA(1)="EACH"
- QUIT
- +9 SET DIC="^ACRPA("
- +10 SET DIC("A")="Which PURCHASING AGENT: "
- +11 SET DIC(0)="AEMQZ"
- +12 WRITE !
- +13 DO DIC^ACRFDIC
- +14 IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +15 SET (ACRPA,ACRPA(1))=+Y
- +16 ;S:$D(^VA(200,+ACRPA,0)) ACRPA=$P(^(0),U) ;ACR*2.1*19.02 IM16848
- +17 ;ACR*2.1*19.02 IM16848
- IF $DATA(^VA(200,+ACRPA,0))
- SET ACRPA=$$NAME2^ACRFUTL1(+ACRPA)
- +18 QUIT
- SORT ;SET THE LIST SEQUENCE BY PO OR REQ NUMBER
- +1 SET DIR(0)="SO^1:List by PO Number;2:List by Requisition Number;3:List by Vendor"
- +2 SET DIR("A")="Which sequence"
- +3 SET DIR("B")=1
- +4 WRITE !
- +5 DO DIR^ACRFDIC
- +6 IF $DATA(ACROUT)!$DATA(ACRQUIT)!($GET(Y)<1)
- QUIT
- +7 SET ACRSORT=+Y
- +8 QUIT
- HEAD ;HEADER
- +1 WRITE @IOF
- +2 WRITE !?10,"PURCHASE ORDER LOG"
- +3 WRITE ?55,"REPORT DATE: "
- +4 SET Y=DT
- +5 XECUTE ^DD("DD")
- +6 WRITE Y
- +7 WRITE !?10,"ORDERS FROM: "
- +8 SET Y=ACRBEGIN
- +9 XECUTE ^DD("DD")
- +10 WRITE Y
- +11 SET ACRI=$GET(ACRI)+1
- +12 WRITE ?55,"PAGE.......: ",ACRI
- +13 WRITE !?10,"ORDERS TO..: "
- +14 SET Y=ACREND
- +15 XECUTE ^DD("DD")
- +16 WRITE Y
- +17 IF ACRI=1
- WRITE !?10,"('*' indicates CANCELLED Purchase Orders)"
- +18 WRITE !?34,"DATE OF"
- +19 WRITE !,"PO NUMBER"
- +20 WRITE ?15,"REQUISITION NO."
- +21 WRITE ?34,"ORDER"
- +22 WRITE ?44,"CONTRACTOR"
- +23 WRITE ?66,"AMOUNT"
- +24 WRITE !,"-------------"
- +25 WRITE ?15,"---------------"
- +26 WRITE ?34,"--------"
- +27 WRITE ?44,"--------------------"
- +28 WRITE ?66,"-------------"
- +29 QUIT
- SSTOT ;EP;TO CALCULATE AND PRINT THE PO TOTAL ON THE PO LOG LISTING
- +1 NEW ACR
- +2 SET ACRSSTOT=0
- +3 SET ACR=ACRDOCDA
- +4 DO SSTOT^ACRFWARN
- +5 IF $GET(ACRSSTOT)
- WRITE $JUSTIFY($FNUMBER(ACRSSTOT,"P,",2),13)
- +6 IF ACRSORT=3
- SET ACRV(ACRDOC)=$GET(ACRV(ACRDOC))+ACRSSTOT
- +7 QUIT
- CANCEL ;PRINT CANCELLED PO'S ONLY
- +1 KILL ACRCANCL
- +2 SET DIR(0)="YO"
- +3 SET DIR("A")="Print CANCELLED PO's only"
- +4 SET DIR("B")="NO"
- +5 WRITE !
- +6 DO DIR^ACRFDIC
- +7 IF +Y=1
- SET ACRCANCL=""
- +8 QUIT