ACRFPO ;IHS/OIRM/DSD/THL,AEF - PURCHASE ORDER PROCESSING; [ 09/23/2005 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
;;ROUTINE USED TO MANAGE VARIOUS ASPECTS OF PURCHASE ORDER PROCESSING
EN ;EP
K ACRQUIT,ACRUCHK,ACRTXDA
F D EN1 Q:$D(ACRQUIT)!$D(ACROUT)
EXIT D EXIT^ACRFPO2
K ^TMP("ACRDATA",$J),ACRONE,^TMP("ACRDATX",$J)
Q
EN1 D:'$D(ACRPO) ASSONE^ACRFPO2
I $D(ACRQUIT)!$D(ACRONE) K ACRONE Q
I $D(ACRPO) S ACRSCRL=10
E D VENDOR^ACRFPO2
Q:$D(ACRQUIT)!$D(ACROUT)
K ACRDUZ
D:ACRSCRL'=6&'$D(ACRPO) AGENT^ACRFPO2
Q:$D(ACRQUIT)!$D(ACROUT)
I $D(ACRDUZ) D Q
.S (ACRRTN,ZTRTN)="EN11^ACRFPO"
.D ^ACRFZIS
.K ACRREV,ACRDUZ
.S ACRQUIT=""
EN11 ;EP;
I $D(ACRDUZ)#2 D
.S ACRREV=""
.S ACRSCRL=(IOSL\2)-5
D HEAD^ACRFPO2
I $D(ACRPO)!$D(ACRPOA) D LOOKUP Q:$D(ACRQUIT)!$D(ACROUT)
D DISPLAY
D SELECT^ACRFPO2:'$D(ACRREV)
D PAUSE:$D(ACRREV)
I $D(ACRQUIT)!$D(ACROUT),'$D(ACRPO) K ACRQUIT
I $D(ACRREV) S ACRQUIT=""
K ACRREV,ACRDUZ
Q
LOOKUP ;EP;
K ^TMP("ACRDATA",$J),^TMP("ACRDATX",$J),ACRREQST
S ACRXREF=$S($D(ACRPO):"PA",1:"PO")
I $D(ACRPO) S ACRPODA=$S('$D(ACRDUZ):DUZ,1:ACRDUZ)
E I $D(^ACRPO("D",DUZ))!$D(^ACRPO("DD",DUZ)) S ACRPODA=$S($D(^ACRPO("D",DUZ)):$O(^(DUZ,0)),1:$O(^ACRPO("DD",DUZ,0)))
E I $D(ACRPOA) D Q
.W !!,"YOU DO NOT HAVE PURCHASING SUPERVISORY AUTHORITY."
.W !,"And you are not an alternate to the Purchasing Supervisor."
.W !,"Contact your ARMS manager for assistance."
.D PAUSE^ACRFWARN
.S ACRQUIT=""
K ACRDATA
N ACRREFZ,ACRAPV
S (ACRDOCDA,ACRJ)=0
F S ACRDOCDA=$O(^ACRDOC(ACRXREF,ACRPODA,"A",ACRDOCDA)) Q:'ACRDOCDA D
.S ACRDOC=^ACRDOC(ACRDOCDA,0)
.S ACRREFZ=$P(ACRDOC,U,13)
.S ACRREFZ=$P($G(^AUTTDOCR(+ACRREFZ,0)),U)
.S ACRAPV=$G(^ACROBL(ACRDOCDA,"APV"))
.I $E(ACRAPV)="A",$P(ACRAPV,U,8)="","^103^349^326^210^"[(U_ACRREFZ_U)!(ACRREFZ=116&($P(ACRDOC,U,4)=35)),$D(^ACRSS("J",ACRDOCDA)) D LIST I 1
I ACRJ K ACRDATA D
.S (ACRJ,ACRRDATE)=0
.F S ACRRDATE=$O(^TMP("ACRDATX",$J,ACRRDATE)) Q:'ACRRDATE D
..S ACRRDAT2=0
..F S ACRRDAT2=$O(^TMP("ACRDATX",$J,ACRRDATE,ACRRDAT2)) Q:'ACRRDAT2 D
...S ACRJ=ACRJ+1
...S ^TMP("ACRDATA",$J,ACRJ)=^TMP("ACRDATX",$J,ACRRDATE,ACRRDAT2)
K ACRQUIT,ACRUCHK
Q
DISPLAY ;EP;
U IO
S (ACRMAX,ACRJ)=0
S:$D(ACRPOA) ACRPADA2=""
F S ACRJ=$O(^TMP("ACRDATA",$J,ACRJ)) Q:'ACRJ!$D(ACRQUIT)!$D(ACROUT) D
.D LIST1
.I $D(ACRQUIT)!$D(ACROUT)!(ACRJ#ACRSCRL=0&(ACRMAX<(ACRJ+ACRSCRL))) S ACRQUIT="" Q
.I ACRJ#ACRSCRL=0 D
..D PAUSE
..D:'$D(ACRQUIT) HEAD^ACRFPO2
K ACRQUIT
Q
LIST ;CREATE PURCHASE ORDER LIST ARRAY
I $D(ACRTRANS),$G(ACRZDA)=ACRDOCDA Q
Q:'$D(^ACRSS("J",ACRDOCDA))&'$P(^ACRDOC(ACRDOCDA,0),U,15)
D OBJ^ACRFPO2
Q:$G(ACROBJ)=""
S ACRJ=ACRJ+1
S ACRDATA=^ACRDOC(ACRDOCDA,0)
S ACRVDA=$P(^ACRDOC(ACRDOCDA,"PO"),U,5)
S ACRPRIOR=$P(^ACRDOC(ACRDOCDA,"DT"),U,4)
S ACRRDATE=$S($P(^ACRDOC(ACRDOCDA,"REQ"),U,11)]"":$P(^("REQ"),U,11),1:$E(DT,1,3)_"0000")
S ACRDOC=$P(ACRDATA,U,2)
S ACRDOC1=$P(ACRDATA,U)
S ACRTXTYP=$P(ACRDATA,U,4)
S ACRREF1=$P(^AUTTDOCR($P(^ACRTXTYP(ACRTXTYP,0),U,2),0),U)
I $G(ACRSCRL)=6 D
.I ACRVDA,$D(^AUTTVNDR(ACRVDA,0)) S ACRVDA=$P(^(0),U)
.E S ACRVDA="NOT STATED"
S ACRPADA=$G(^ACRDOC(ACRDOCDA,"PA"))
S ACRPADAT=$P(ACRPADA,U,2)
S ACRPADA=+ACRPADA
S ACRPA=""
I ACRPADA,$D(ACRPOA) D
.;S ACRPA=$G(^VA(200,ACRPADA,0)) ;ACR*2.1*19.02 IM16848
.;S ACRPA=$E($E($P($P(ACRPA,U),",",2))_" "_$P(ACRPA,","),1,11) ;ACR*2.1*19.02 IM16848
.S ACRPA=$$NAME2^ACRFUTL1(ACRPADA) ;ACR*2.1*19.02 IM16848
.S ACRPA=$E($E($P(ACRPA,",",2))_" "_$P(ACRPA,","),1,11) ;ACR*2.1*19.02 IM16848
S:$L($P(ACRPADAT,"."))=7 ACRPA=ACRPA_" "_$E(ACRPADAT,4,5)_"/"_$E(ACRPADAT,6,7)
S ACRPA=$S(ACRPA["PURCHASING":"",1:ACRPA)
S X=0
S:ACRPRIOR'="E" ACRPRIOR=""
F S X=$O(^ACRAPVS("AB",ACRDOCDA,X)) Q:'X S:$P($G(^ACRAPVS(X,0)),U,3)=1 ACRPRIOR="*"
S Y=ACRRDATE
S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_($E(Y,1,3)+1700)
D ITOT
S ^TMP("ACRDATX",$J,ACRRDATE,ACRJ)=ACRDOCDA_U_ACRREF1_U_ACRTXTYP_U_Y_U_ACRPA_U_ACRDOC1_U_ACRPADA_U_ACRPRIOR_U_ACROBJ_U_ACRITOT_U_ACRVDA
Q
LIST1 ;
N X,Y
S:'$G(ACRSCRL) ACRSCRL=6
Q:$D(ACRQUIT)!$D(ACROUT)!'$D(^TMP("ACRDATA",$J,ACRJ))#2
S X=^TMP("ACRDATA",$J,ACRJ)
W !
S:ACRMAX<ACRJ ACRMAX=ACRJ
W ACRJ
W ?6,$P(X,U,8)
W ?7,$P(X,U,6)
W ?24,$P(X,U,4)
I $D(^TMP("ACRDATA",$J,ACRJ+ACRSCRL)) S Y=^TMP("ACRDATA",$J,ACRJ+ACRSCRL) D
.W ?40,"|",ACRJ+ACRSCRL
.W ?47,$P(Y,U,8)
.W ?48,$P(Y,U,6)
.W ?65,$E($P(Y,U,4),1,15)
.S ACRMAX=ACRJ+ACRSCRL
I $D(ACRPOA)!$D(ACRPO) D
.W !?7
.W $P(X,U,5)
.W ?24,$P(X,U,9),$J($FN($P(X,U,10),"P,",0),12)
.I $D(Y) D
..W ?40,"|"
..W ?48,$P(Y,U,5)
..W ?65,$P(Y,U,9),$J($FN($P(Y,U,10),"P,",0),10)
.Q:ACRSCRL>6
.W !?7,$P(X,U,11)
.I $D(Y) D
..W ?40,"|"
..W ?48,$P(Y,U,11)
Q
PAUSE I $E(IOST,1,2)'="C-" S ACRJ=ACRJ+ACRSCRL Q
S DIR(0)="YO"
S DIR("A")=" Display more documents"
S DIR("B")="YES"
W !
D DIR^ACRFDIC
I Y=1 W ! S ACRJ=ACRJ+ACRSCRL Q
S ACRQUIT=""
Q
ACRPOA ;EP;TO ASSIGN PO TO PA
S ACRPOA=""
D EN
K ACRPOA
Q
ACRPO ;EP;TO BEGIN PO ADD/EDIT
N ACRPO,ACRENTRY
S ACRENTRY="PO"
S ACRPO=""
F D MOD^ACRFPO1 Q:$D(ACRQUIT)!$D(ACROUT)
Q
ACRPPO ;EP;TO PRINT PURCHASE ORDER
N ACRPRT,ACRPPO,ACRENTRY
S ACRENTRY="PO"
S (ACRPRT,ACRPPO)=""
D PRINT^ACRFPO1
Q
ITOT ;CALCULATE ITEM TOTALS FOR THE PO
N X
S (X,ACRITOT)=0
F S X=$O(^ACRSS("J",ACRDOCDA,X)) Q:'X S ACRITOT=ACRITOT+$P($G(^ACRSS(X,"DT")),U,4)
Q
ACRFPO ;IHS/OIRM/DSD/THL,AEF - PURCHASE ORDER PROCESSING; [ 09/23/2005 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
+2 ;;ROUTINE USED TO MANAGE VARIOUS ASPECTS OF PURCHASE ORDER PROCESSING
EN ;EP
+1 KILL ACRQUIT,ACRUCHK,ACRTXDA
+2 FOR
DO EN1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
EXIT DO EXIT^ACRFPO2
+1 KILL ^TMP("ACRDATA",$JOB),ACRONE,^TMP("ACRDATX",$JOB)
+2 QUIT
EN1 IF '$DATA(ACRPO)
DO ASSONE^ACRFPO2
+1 IF $DATA(ACRQUIT)!$DATA(ACRONE)
KILL ACRONE
QUIT
+2 IF $DATA(ACRPO)
SET ACRSCRL=10
+3 IF '$TEST
DO VENDOR^ACRFPO2
+4 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+5 KILL ACRDUZ
+6 IF ACRSCRL'=6&'$DATA(ACRPO)
DO AGENT^ACRFPO2
+7 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+8 IF $DATA(ACRDUZ)
Begin DoDot:1
+9 SET (ACRRTN,ZTRTN)="EN11^ACRFPO"
+10 DO ^ACRFZIS
+11 KILL ACRREV,ACRDUZ
+12 SET ACRQUIT=""
End DoDot:1
QUIT
EN11 ;EP;
+1 IF $DATA(ACRDUZ)#2
Begin DoDot:1
+2 SET ACRREV=""
+3 SET ACRSCRL=(IOSL\2)-5
End DoDot:1
+4 DO HEAD^ACRFPO2
+5 IF $DATA(ACRPO)!$DATA(ACRPOA)
DO LOOKUP
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+6 DO DISPLAY
+7 IF '$DATA(ACRREV)
DO SELECT^ACRFPO2
+8 IF $DATA(ACRREV)
DO PAUSE
+9 IF $DATA(ACRQUIT)!$DATA(ACROUT)
IF '$DATA(ACRPO)
KILL ACRQUIT
+10 IF $DATA(ACRREV)
SET ACRQUIT=""
+11 KILL ACRREV,ACRDUZ
+12 QUIT
LOOKUP ;EP;
+1 KILL ^TMP("ACRDATA",$JOB),^TMP("ACRDATX",$JOB),ACRREQST
+2 SET ACRXREF=$SELECT($DATA(ACRPO):"PA",1:"PO")
+3 IF $DATA(ACRPO)
SET ACRPODA=$SELECT('$DATA(ACRDUZ):DUZ,1:ACRDUZ)
+4 IF '$TEST
IF $DATA(^ACRPO("D",DUZ))!$DATA(^ACRPO("DD",DUZ))
SET ACRPODA=$SELECT($DATA(^ACRPO("D",DUZ)):$ORDER(^(DUZ,0)),1:$ORDER(^ACRPO("DD",DUZ,0)))
+5 IF '$TEST
IF $DATA(ACRPOA)
Begin DoDot:1
+6 WRITE !!,"YOU DO NOT HAVE PURCHASING SUPERVISORY AUTHORITY."
+7 WRITE !,"And you are not an alternate to the Purchasing Supervisor."
+8 WRITE !,"Contact your ARMS manager for assistance."
+9 DO PAUSE^ACRFWARN
+10 SET ACRQUIT=""
End DoDot:1
QUIT
+11 KILL ACRDATA
+12 NEW ACRREFZ,ACRAPV
+13 SET (ACRDOCDA,ACRJ)=0
+14 FOR
SET ACRDOCDA=$ORDER(^ACRDOC(ACRXREF,ACRPODA,"A",ACRDOCDA))
IF 'ACRDOCDA
QUIT
Begin DoDot:1
+15 SET ACRDOC=^ACRDOC(ACRDOCDA,0)
+16 SET ACRREFZ=$PIECE(ACRDOC,U,13)
+17 SET ACRREFZ=$PIECE($GET(^AUTTDOCR(+ACRREFZ,0)),U)
+18 SET ACRAPV=$GET(^ACROBL(ACRDOCDA,"APV"))
+19 IF $EXTRACT(ACRAPV)="A"
IF $PIECE(ACRAPV,U,8)=""
IF "^103^349^326^210^"[(U_ACRREFZ_U)!(ACRREFZ=116&($PIECE(ACRDOC,U,4)=35))
IF $DATA(^ACRSS("J",ACRDOCDA))
DO LIST
IF 1
End DoDot:1
+20 IF ACRJ
KILL ACRDATA
Begin DoDot:1
+21 SET (ACRJ,ACRRDATE)=0
+22 FOR
SET ACRRDATE=$ORDER(^TMP("ACRDATX",$JOB,ACRRDATE))
IF 'ACRRDATE
QUIT
Begin DoDot:2
+23 SET ACRRDAT2=0
+24 FOR
SET ACRRDAT2=$ORDER(^TMP("ACRDATX",$JOB,ACRRDATE,ACRRDAT2))
IF 'ACRRDAT2
QUIT
Begin DoDot:3
+25 SET ACRJ=ACRJ+1
+26 SET ^TMP("ACRDATA",$JOB,ACRJ)=^TMP("ACRDATX",$JOB,ACRRDATE,ACRRDAT2)
End DoDot:3
End DoDot:2
End DoDot:1
+27 KILL ACRQUIT,ACRUCHK
+28 QUIT
DISPLAY ;EP;
+1 USE IO
+2 SET (ACRMAX,ACRJ)=0
+3 IF $DATA(ACRPOA)
SET ACRPADA2=""
+4 FOR
SET ACRJ=$ORDER(^TMP("ACRDATA",$JOB,ACRJ))
IF 'ACRJ!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:1
+5 DO LIST1
+6 IF $DATA(ACRQUIT)!$DATA(ACROUT)!(ACRJ#ACRSCRL=0&(ACRMAX<(ACRJ+ACRSCRL)))
SET ACRQUIT=""
QUIT
+7 IF ACRJ#ACRSCRL=0
Begin DoDot:2
+8 DO PAUSE
+9 IF '$DATA(ACRQUIT)
DO HEAD^ACRFPO2
End DoDot:2
End DoDot:1
+10 KILL ACRQUIT
+11 QUIT
LIST ;CREATE PURCHASE ORDER LIST ARRAY
+1 IF $DATA(ACRTRANS)
IF $GET(ACRZDA)=ACRDOCDA
QUIT
+2 IF '$DATA(^ACRSS("J",ACRDOCDA))&'$PIECE(^ACRDOC(ACRDOCDA,0),U,15)
QUIT
+3 DO OBJ^ACRFPO2
+4 IF $GET(ACROBJ)=""
QUIT
+5 SET ACRJ=ACRJ+1
+6 SET ACRDATA=^ACRDOC(ACRDOCDA,0)
+7 SET ACRVDA=$PIECE(^ACRDOC(ACRDOCDA,"PO"),U,5)
+8 SET ACRPRIOR=$PIECE(^ACRDOC(ACRDOCDA,"DT"),U,4)
+9 SET ACRRDATE=$SELECT($PIECE(^ACRDOC(ACRDOCDA,"REQ"),U,11)]"":$PIECE(^("REQ"),U,11),1:$EXTRACT(DT,1,3)_"0000")
+10 SET ACRDOC=$PIECE(ACRDATA,U,2)
+11 SET ACRDOC1=$PIECE(ACRDATA,U)
+12 SET ACRTXTYP=$PIECE(ACRDATA,U,4)
+13 SET ACRREF1=$PIECE(^AUTTDOCR($PIECE(^ACRTXTYP(ACRTXTYP,0),U,2),0),U)
+14 IF $GET(ACRSCRL)=6
Begin DoDot:1
+15 IF ACRVDA
IF $DATA(^AUTTVNDR(ACRVDA,0))
SET ACRVDA=$PIECE(^(0),U)
+16 IF '$TEST
SET ACRVDA="NOT STATED"
End DoDot:1
+17 SET ACRPADA=$GET(^ACRDOC(ACRDOCDA,"PA"))
+18 SET ACRPADAT=$PIECE(ACRPADA,U,2)
+19 SET ACRPADA=+ACRPADA
+20 SET ACRPA=""
+21 IF ACRPADA
IF $DATA(ACRPOA)
Begin DoDot:1
+22 ;S ACRPA=$G(^VA(200,ACRPADA,0)) ;ACR*2.1*19.02 IM16848
+23 ;S ACRPA=$E($E($P($P(ACRPA,U),",",2))_" "_$P(ACRPA,","),1,11) ;ACR*2.1*19.02 IM16848
+24 ;ACR*2.1*19.02 IM16848
SET ACRPA=$$NAME2^ACRFUTL1(ACRPADA)
+25 ;ACR*2.1*19.02 IM16848
SET ACRPA=$EXTRACT($EXTRACT($PIECE(ACRPA,",",2))_" "_$PIECE(ACRPA,","),1,11)
End DoDot:1
+26 IF $LENGTH($PIECE(ACRPADAT,"."))=7
SET ACRPA=ACRPA_" "_$EXTRACT(ACRPADAT,4,5)_"/"_$EXTRACT(ACRPADAT,6,7)
+27 SET ACRPA=$SELECT(ACRPA["PURCHASING":"",1:ACRPA)
+28 SET X=0
+29 IF ACRPRIOR'="E"
SET ACRPRIOR=""
+30 FOR
SET X=$ORDER(^ACRAPVS("AB",ACRDOCDA,X))
IF 'X
QUIT
IF $PIECE($GET(^ACRAPVS(X,0)),U,3)=1
SET ACRPRIOR="*"
+31 SET Y=ACRRDATE
+32 SET Y=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_($EXTRACT(Y,1,3)+1700)
+33 DO ITOT
+34 SET ^TMP("ACRDATX",$JOB,ACRRDATE,ACRJ)=ACRDOCDA_U_ACRREF1_U_ACRTXTYP_U_Y_U_ACRPA_U_ACRDOC1_U_ACRPADA_U_ACRPRIOR_U_ACROBJ_U_ACRITOT_U_ACRVDA
+35 QUIT
LIST1 ;
+1 NEW X,Y
+2 IF '$GET(ACRSCRL)
SET ACRSCRL=6
+3 IF $DATA(ACRQUIT)!$DATA(ACROUT)!'$DATA(^TMP("ACRDATA",$JOB,ACRJ))#2
QUIT
+4 SET X=^TMP("ACRDATA",$JOB,ACRJ)
+5 WRITE !
+6 IF ACRMAX<ACRJ
SET ACRMAX=ACRJ
+7 WRITE ACRJ
+8 WRITE ?6,$PIECE(X,U,8)
+9 WRITE ?7,$PIECE(X,U,6)
+10 WRITE ?24,$PIECE(X,U,4)
+11 IF $DATA(^TMP("ACRDATA",$JOB,ACRJ+ACRSCRL))
SET Y=^TMP("ACRDATA",$JOB,ACRJ+ACRSCRL)
Begin DoDot:1
+12 WRITE ?40,"|",ACRJ+ACRSCRL
+13 WRITE ?47,$PIECE(Y,U,8)
+14 WRITE ?48,$PIECE(Y,U,6)
+15 WRITE ?65,$EXTRACT($PIECE(Y,U,4),1,15)
+16 SET ACRMAX=ACRJ+ACRSCRL
End DoDot:1
+17 IF $DATA(ACRPOA)!$DATA(ACRPO)
Begin DoDot:1
+18 WRITE !?7
+19 WRITE $PIECE(X,U,5)
+20 WRITE ?24,$PIECE(X,U,9),$JUSTIFY($FNUMBER($PIECE(X,U,10),"P,",0),12)
+21 IF $DATA(Y)
Begin DoDot:2
+22 WRITE ?40,"|"
+23 WRITE ?48,$PIECE(Y,U,5)
+24 WRITE ?65,$PIECE(Y,U,9),$JUSTIFY($FNUMBER($PIECE(Y,U,10),"P,",0),10)
End DoDot:2
+25 IF ACRSCRL>6
QUIT
+26 WRITE !?7,$PIECE(X,U,11)
+27 IF $DATA(Y)
Begin DoDot:2
+28 WRITE ?40,"|"
+29 WRITE ?48,$PIECE(Y,U,11)
End DoDot:2
End DoDot:1
+30 QUIT
PAUSE IF $EXTRACT(IOST,1,2)'="C-"
SET ACRJ=ACRJ+ACRSCRL
QUIT
+1 SET DIR(0)="YO"
+2 SET DIR("A")=" Display more documents"
+3 SET DIR("B")="YES"
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF Y=1
WRITE !
SET ACRJ=ACRJ+ACRSCRL
QUIT
+7 SET ACRQUIT=""
+8 QUIT
ACRPOA ;EP;TO ASSIGN PO TO PA
+1 SET ACRPOA=""
+2 DO EN
+3 KILL ACRPOA
+4 QUIT
ACRPO ;EP;TO BEGIN PO ADD/EDIT
+1 NEW ACRPO,ACRENTRY
+2 SET ACRENTRY="PO"
+3 SET ACRPO=""
+4 FOR
DO MOD^ACRFPO1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+5 QUIT
ACRPPO ;EP;TO PRINT PURCHASE ORDER
+1 NEW ACRPRT,ACRPPO,ACRENTRY
+2 SET ACRENTRY="PO"
+3 SET (ACRPRT,ACRPPO)=""
+4 DO PRINT^ACRFPO1
+5 QUIT
ITOT ;CALCULATE ITEM TOTALS FOR THE PO
+1 NEW X
+2 SET (X,ACRITOT)=0
+3 FOR
SET X=$ORDER(^ACRSS("J",ACRDOCDA,X))
IF 'X
QUIT
SET ACRITOT=ACRITOT+$PIECE($GET(^ACRSS(X,"DT")),U,4)
+4 QUIT
