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
