- 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
