ACRFPRCS ;IHS/OIRM/DSD/THL,AEF - PROCESS PENDING DOCUMENTS; [ 02/22/2007 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**22**;NOV 05, 2001
;;ROUTINE TO CONTROL LISTING AND SIGNATURE PROCESS FOR ARMS DOCS
EN D EXIT^ACRFPRC2
D ENA:$D(^ACRAPL("AC",DUZ))
EXIT D EXIT^ACRFPRC2
K ACRREV
;I $D(ACRDTIME) S DTIME=ACRDTIME K ACRDTIME ;ACR*2.1*22 SAC COMPLIANCE
Q
ENA D RESP^ACRFPRC2
N ACRREF,ACRDATA
I $D(ACRCSI) S ACRREV="" F D CSI^ACRFPRC2 Q:$D(ACRQUIT)!$D(ACROUT) D
.I '$D(^TMP("ACRDATA",$J))#2 D Q
..W !!,"NO "_$P(ACRTX(ACRY),U,2)_" PENDING"
..H 2
.I $D(^TMP("ACRDATA",$J))#2 D
..S DIR(0)="YO"
..S DIR("A")="Review Document in detail"
..S DIR("B")="NO"
..W !
..D DIR^ACRFDIC
..D EN2:Y=1
..K ACRDATA1
EN1 I '$D(ACRQUIT) F D EN2 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
I '$D(ACROUT),$D(^TMP("ACRALTDT",$J)) D ^ACRFALT
Q
EN2 ;
D LOOKUP
EN21 ;EP;
D SELECT:'$D(ACRQUIT)&ACRI
I 'ACRI S ACRQUIT=""
Q:$D(ACRQUIT)!$D(ACROUT)
D EDIT^ACRFPRC9
I $D(^ACROBL(ACRDOCDA,2)) D TREPORT^ACRFPRC4
K ACRPSUM
D APPROVE^ACRFPRC1:'$D(ACRCSI)
K ACRQUIT
Q
LOOKUP ;LOOKUP OF DOCUMENTS WHICH NEED CURRENT USER'S SIGNATURE
;DOCUMENTS PENDING SIGNATURE OF CURRENT USER OR ALTERNATE
;KILL ANXT CROSSREFERENCE DURING LOOKUP IF IT IS INAPPROPRIATE
S ACRI=0
S ACRDUZ=DUZ
K ^TMP("ACRDATA",$J,DUZ)
I $D(^TMP("ACRDATA",$J,ACRDUZ)) D RELIST^ACRFPRC4 G LX
S ACRAPVT=0
K ^TMP("ACRALT",$J),^TMP("ACRALTDT",$J)
F S ACRAPVT=$O(^ACRAPVS("ANXT",ACRAPVT)) Q:'ACRAPVT D
.W "."
.S ACRINDV=0
.F S ACRINDV=$O(^ACRAPVS("ANXT",ACRAPVT,ACRINDV)) Q:'ACRINDV I $D(^ACRAPL("AC",ACRINDV,ACRAPVT)) S ACRAPLDA=$O(^(ACRAPVT,0)) D:ACRAPLDA
..S ACRAPLDT=+$G(^ACRAPL(ACRAPLDA,0))_U_$G(^ACRAPL(ACRAPLDA,"DT"))
..Q:(U_ACRAPLDT_U)'[(U_DUZ_U)
..S ACRAPDA=0
..F S ACRAPDA=$O(^ACRAPVS("ANXT",ACRAPVT,ACRINDV,ACRAPDA)) Q:'ACRAPDA D:DT+1>$P($G(^(ACRAPDA)),U,2)
...S ACRAP0=$G(^ACRAPVS(ACRAPDA,0))
...S ACRAPDT=$G(^ACRAPVS(ACRAPDA,"DT"))
...Q:DT<$P(ACRAPDT,U,8)
...I $P(ACRAPDT,U)]""!($P(ACRAPDT,U,3)="")!('$D(^ACRAPVS("AB",+ACRAP0,ACRAPDA))) D Q
....K ^ACRAPVS("ANXT",ACRAPVT,ACRINDV,ACRAPDA)
....N ACRDOCDA
....S ACRDOCDA=+ACRAP0
....D EN1^ACRFNXT
...S ACRDATE=$P(ACRAPDT,U,3)
...D LIST^ACRFPRC4
I '$D(ACRESIG),$D(^TMP("ACRDATE",$J,DUZ))!$D(^TMP("ACRALTDT",$J)) D Q:$D(ACROUT)
.D ESIG^ACRFPRC4
.I $D(ACRQUIT)!$D(ACROUT) S ACROUT="" K ACRESIG Q
.;S ACRDTIME=DTIME ;ACR*2.1*22 SAC COMPLIANCE
.;S:DTIME<120 DTIME=120 ;ACR*2.1*22 SAC COMPLIANCE
.D SECURITY^ACRFPRC4
I '$D(^TMP("ACRDATE",$J,DUZ)) D Q
.W !!,@ACRON,"There are no DOCUMENTS pending for you.",@ACROF
.W !
.H 2
.S ACRQUIT=""
E D RELIST^ACRFPRC4
LX D LIST2
Q
SELECT ;SELECT DOCUMENT TO BE REVIEWED FOR APPROVAL
S DIR(0)="FOA^1:15"
S DIR("A",1)="Enter a Sequence NO. (1 to "_ACRMAX_")"
S DIR("A")="or enter the DOCUMENT NUMBER: "
S DIR("?",1)="Enter the number listed under column 'NO.' of the document you want to approve,"
S DIR("?",2)="or enter the DOCUMENT NUMBER of the document you want to review."
S DIR("?")="Select a number from 1 to "_ACRMAX
W !
D DIR^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT)!'$D(^TMP("ACRDATA",$J,ACRDUZ,$S(X]"":X,1:0))) S ACRI="" Q
N ACRENTRY,ACRDOC
S (ACRJJ,ACRX)=X
S ACRENTRY="OBLAMT"
S X=^TMP("ACRDATA",$J,ACRDUZ,ACRX)
I $L(ACRJJ)>8 S ACRJJ=$P(X,U,10)
S (ACRZDA,DA,ACRDOCDA)=$P(X,U)
S ACRTXTYP=$P(X,U,3)
S ACRAPDA=$P(X,U,4)
D SETDOC^ACRFEA1
S ACRREFX=ACRREF
K ACRSIGN
S ACR=0
F S ACR=$O(^ACRAPVS("AB",ACRZDA,ACR)) Q:'ACR I ACRAPDA'=ACR,$D(^ACRAPVS(ACR,0)),$D(^ACRAPVS(ACR,"DT")) D
.S ACRAPV0=^ACRAPVS(ACR,0),ACRAPVDT=^ACRAPVS(ACR,"DT")
.I "^1^2^5^36^40^43^"[(U_+$P(ACRAPV0,U,3)_U) S ACRAPVS($P(ACRAPV0,U,3))=U_$S($P(ACRAPVDT,U,6)]"":$P(ACRAPVDT,U,6),1:$P(ACRAPVDT,U,2))_U
.I "^1^2^7^12^14^21^22^23^24^31^37^38^39^45^"'[(U_$P(ACRAPV0,U,3)_U),$P(ACRAPVDT,U,5)'="Y",$P(ACRAPVDT,U)="",$P(ACRAPVDT,U,2)=DUZ,$P(ACRAPVDT,U,5)="" S ACRSIGN(ACR)=""
Q
LIST2 ;EP;
S (ACRXX,ACRMAX)=0
F S ACRXX=$O(^TMP("ACRDATA",$J,ACRDUZ,ACRXX)) Q:'ACRXX!($L(ACRXX)>8) S ACRMAX=ACRMAX+1
D HEAD^ACRFPRC9:$O(^TMP("ACRDATA",$J,ACRDUZ,0))
S ACRI=0
F D LIST21 D:ACRI>0&(ACRI#10=0) PAUSE^ACRFPRC4 Q:$D(ACRQUIT)!$D(ACROUT)!(ACRI#10=0&('$D(^TMP("ACRDATA",$J,ACRDUZ,ACRI+1))))
K ACRQUIT
Q
LIST21 I '$D(^TMP("ACRDATA",$J,ACRDUZ,ACRI+1)) S ACRQUIT="" Q
N X,ACRAPDA
S ACRI=ACRI+1
S ACRII=ACRI+10
S X=^TMP("ACRDATA",$J,ACRDUZ,ACRI)
S ACRDOC=$P(X,U,5)
S ACRID=$P(X,U,6)
S ACRAPDA=$P(X,U,4)
W !,$J(ACRI,2)
K ACRQUIT
S X=0
F S X=$O(^ACRAPVS(ACRAPDA,1,X)) Q:'X I $D(^ACRAPVS(ACRAPDA,1,X,"CNG"))!$D(^ACRAPVS(ACRAPDA,1,X,"RSN"))!$D(^ACRAPVS(ACRAPDA,1,X,"RESP")) S ACRQUIT="" Q
I $D(ACRQUIT) K ACRQUIT W ?4,"**"
I $P($G(^ACRAPVS(+ACRAPDA,0)),U,11) W ?4,"TA"
I $P($G(^ACRDOC(+$G(^ACRAPVS(+ACRAPDA,0)),0)),U,28)=0 W ?4,"NR"
E W ?4,$$TOT(+$G(^ACRAPVS(+ACRAPDA,0)))
W ?7,ACRDOC
W ?24,ACRID
Q:'$D(^TMP("ACRDATA",$J,ACRDUZ,ACRII))
S X=^TMP("ACRDATA",$J,ACRDUZ,ACRII)
S ACRDOC=$P(X,U,5)
S ACRID=$P(X,U,6)
S ACRAPDA=$P(X,U,4)
W ?40,"|",$J((ACRII),2)
K ACRQUIT
S X=0
F S X=$O(^ACRAPVS(ACRAPDA,1,X)) Q:'X I $D(^ACRAPVS(ACRAPDA,1,X,"CNG"))!$D(^ACRAPVS(ACRAPDA,1,X,"RSN"))!$D(^ACRAPVS(ACRAPDA,1,X,"RESP")) S ACRQUIT="" Q
I $D(ACRQUIT) K ACRQUIT W ?45,"**"
I $P($G(^ACRAPVS(+ACRAPDA,0)),U,11) W ?4,"TA"
I $P($G(^ACRDOC(+$G(^ACRAPVS(+ACRAPDA,0)),0)),U,28)=0 W ?45,"NR"
I "130^600^"[(U_ACRREF_U) W ?4,$$TOT(+$G(^ACRAPVS(+ACRAPDA,0)))
W ?48,ACRDOC
W ?65,ACRID
Q
ACRREV ;EP;FOR DOCUMENT APPROVAL
;CALLED FROM ENTRY ACTION OF ACRMENU
Q:$D(ACRNOFM) ;ACR*2.1*22.03 IM22653
D TE^ACRFPRC9
S:$D(ACRDOCDA) ACRDOCXX=ACRDOCDA
D HOME^ACRFMENU:'$D(ACRON)
S ACRREV=""
W !!,"One moment, please."
W !!,"I need to review all documents pending for approval"
W !,"to determine if there are any which you need to sign."
W !!
D EN
K ACRREV
S:$D(ACRDOCXX) ACRDOCDA=ACRDOCXX
K ACRDOCXX
Q
ACRCSI ;EP;TO PRINT STATUS OF DOCUMENTS
N ACRENTRY
S ACRENTRY="OBLAMT"
S ACRENTR1="LOCBAMT"
S (ACRREV,ACRCSI)=""
D EN
Q
SPSUM ;EP;TO REVIEW SMALL PURCHASE SUMMARY
S DIR(0)="YO"
S DIR("A")="Review Small Purchase Summary"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)!(Y'=1)
W !!
N DXS,DIP,DC,DN
D ^ACGPSP
D PAUSE^ACRFWARN
Q
TOT(X) ;DETERMINE IF TRAVEL ORDER IS ZERO AMOUNT
Q:'X
N Y,Z
S (Y,Z)=0
F S Y=$O(^ACRSS("J",X,Y)) Q:'Y S Z=Z+$P($G(^ACRSS(Y,"DT")),U,4)
I Z<1 S Z="ZZ"
E S Z=""
Q Z
ACRFPRCS ;IHS/OIRM/DSD/THL,AEF - PROCESS PENDING DOCUMENTS; [ 02/22/2007 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**22**;NOV 05, 2001
+2 ;;ROUTINE TO CONTROL LISTING AND SIGNATURE PROCESS FOR ARMS DOCS
EN DO EXIT^ACRFPRC2
+1 IF $DATA(^ACRAPL("AC",DUZ))
DO ENA
EXIT DO EXIT^ACRFPRC2
+1 KILL ACRREV
+2 ;I $D(ACRDTIME) S DTIME=ACRDTIME K ACRDTIME ;ACR*2.1*22 SAC COMPLIANCE
+3 QUIT
ENA DO RESP^ACRFPRC2
+1 NEW ACRREF,ACRDATA
+2 IF $DATA(ACRCSI)
SET ACRREV=""
FOR
DO CSI^ACRFPRC2
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:1
+3 IF '$DATA(^TMP("ACRDATA",$JOB))#2
Begin DoDot:2
+4 WRITE !!,"NO "_$PIECE(ACRTX(ACRY),U,2)_" PENDING"
+5 HANG 2
End DoDot:2
QUIT
+6 IF $DATA(^TMP("ACRDATA",$JOB))#2
Begin DoDot:2
+7 SET DIR(0)="YO"
+8 SET DIR("A")="Review Document in detail"
+9 SET DIR("B")="NO"
+10 WRITE !
+11 DO DIR^ACRFDIC
+12 IF Y=1
DO EN2
+13 KILL ACRDATA1
End DoDot:2
End DoDot:1
EN1 IF '$DATA(ACRQUIT)
FOR
DO EN2
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+1 KILL ACRQUIT
+2 IF '$DATA(ACROUT)
IF $DATA(^TMP("ACRALTDT",$JOB))
DO ^ACRFALT
+3 QUIT
EN2 ;
+1 DO LOOKUP
EN21 ;EP;
+1 IF '$DATA(ACRQUIT)&ACRI
DO SELECT
+2 IF 'ACRI
SET ACRQUIT=""
+3 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+4 DO EDIT^ACRFPRC9
+5 IF $DATA(^ACROBL(ACRDOCDA,2))
DO TREPORT^ACRFPRC4
+6 KILL ACRPSUM
+7 IF '$DATA(ACRCSI)
DO APPROVE^ACRFPRC1
+8 KILL ACRQUIT
+9 QUIT
LOOKUP ;LOOKUP OF DOCUMENTS WHICH NEED CURRENT USER'S SIGNATURE
+1 ;DOCUMENTS PENDING SIGNATURE OF CURRENT USER OR ALTERNATE
+2 ;KILL ANXT CROSSREFERENCE DURING LOOKUP IF IT IS INAPPROPRIATE
+3 SET ACRI=0
+4 SET ACRDUZ=DUZ
+5 KILL ^TMP("ACRDATA",$JOB,DUZ)
+6 IF $DATA(^TMP("ACRDATA",$JOB,ACRDUZ))
DO RELIST^ACRFPRC4
GOTO LX
+7 SET ACRAPVT=0
+8 KILL ^TMP("ACRALT",$JOB),^TMP("ACRALTDT",$JOB)
+9 FOR
SET ACRAPVT=$ORDER(^ACRAPVS("ANXT",ACRAPVT))
IF 'ACRAPVT
QUIT
Begin DoDot:1
+10 WRITE "."
+11 SET ACRINDV=0
+12 FOR
SET ACRINDV=$ORDER(^ACRAPVS("ANXT",ACRAPVT,ACRINDV))
IF 'ACRINDV
QUIT
IF $DATA(^ACRAPL("AC",ACRINDV,ACRAPVT))
SET ACRAPLDA=$ORDER(^(ACRAPVT,0))
IF ACRAPLDA
Begin DoDot:2
+13 SET ACRAPLDT=+$GET(^ACRAPL(ACRAPLDA,0))_U_$GET(^ACRAPL(ACRAPLDA,"DT"))
+14 IF (U_ACRAPLDT_U)'[(U_DUZ_U)
QUIT
+15 SET ACRAPDA=0
+16 FOR
SET ACRAPDA=$ORDER(^ACRAPVS("ANXT",ACRAPVT,ACRINDV,ACRAPDA))
IF 'ACRAPDA
QUIT
IF DT+1>$PIECE($GET(^(ACRAPDA)),U,2)
Begin DoDot:3
+17 SET ACRAP0=$GET(^ACRAPVS(ACRAPDA,0))
+18 SET ACRAPDT=$GET(^ACRAPVS(ACRAPDA,"DT"))
+19 IF DT<$PIECE(ACRAPDT,U,8)
QUIT
+20 IF $PIECE(ACRAPDT,U)]""!($PIECE(ACRAPDT,U,3)="")!('$DATA(^ACRAPVS("AB",+ACRAP0,ACRAPDA)))
Begin DoDot:4
+21 KILL ^ACRAPVS("ANXT",ACRAPVT,ACRINDV,ACRAPDA)
+22 NEW ACRDOCDA
+23 SET ACRDOCDA=+ACRAP0
+24 DO EN1^ACRFNXT
End DoDot:4
QUIT
+25 SET ACRDATE=$PIECE(ACRAPDT,U,3)
+26 DO LIST^ACRFPRC4
End DoDot:3
End DoDot:2
End DoDot:1
+27 IF '$DATA(ACRESIG)
IF $DATA(^TMP("ACRDATE",$JOB,DUZ))!$DATA(^TMP("ACRALTDT",$JOB))
Begin DoDot:1
+28 DO ESIG^ACRFPRC4
+29 IF $DATA(ACRQUIT)!$DATA(ACROUT)
SET ACROUT=""
KILL ACRESIG
QUIT
+30 ;S ACRDTIME=DTIME ;ACR*2.1*22 SAC COMPLIANCE
+31 ;S:DTIME<120 DTIME=120 ;ACR*2.1*22 SAC COMPLIANCE
+32 DO SECURITY^ACRFPRC4
End DoDot:1
IF $DATA(ACROUT)
QUIT
+33 IF '$DATA(^TMP("ACRDATE",$JOB,DUZ))
Begin DoDot:1
+34 WRITE !!,@ACRON,"There are no DOCUMENTS pending for you.",@ACROF
+35 WRITE !
+36 HANG 2
+37 SET ACRQUIT=""
End DoDot:1
QUIT
+38 IF '$TEST
DO RELIST^ACRFPRC4
LX DO LIST2
+1 QUIT
SELECT ;SELECT DOCUMENT TO BE REVIEWED FOR APPROVAL
+1 SET DIR(0)="FOA^1:15"
+2 SET DIR("A",1)="Enter a Sequence NO. (1 to "_ACRMAX_")"
+3 SET DIR("A")="or enter the DOCUMENT NUMBER: "
+4 SET DIR("?",1)="Enter the number listed under column 'NO.' of the document you want to approve,"
+5 SET DIR("?",2)="or enter the DOCUMENT NUMBER of the document you want to review."
+6 SET DIR("?")="Select a number from 1 to "_ACRMAX
+7 WRITE !
+8 DO DIR^ACRFDIC
+9 IF $DATA(ACRQUIT)!$DATA(ACROUT)!'$DATA(^TMP("ACRDATA",$JOB,ACRDUZ,$SELECT(X]"":X,1:0)))
SET ACRI=""
QUIT
+10 NEW ACRENTRY,ACRDOC
+11 SET (ACRJJ,ACRX)=X
+12 SET ACRENTRY="OBLAMT"
+13 SET X=^TMP("ACRDATA",$JOB,ACRDUZ,ACRX)
+14 IF $LENGTH(ACRJJ)>8
SET ACRJJ=$PIECE(X,U,10)
+15 SET (ACRZDA,DA,ACRDOCDA)=$PIECE(X,U)
+16 SET ACRTXTYP=$PIECE(X,U,3)
+17 SET ACRAPDA=$PIECE(X,U,4)
+18 DO SETDOC^ACRFEA1
+19 SET ACRREFX=ACRREF
+20 KILL ACRSIGN
+21 SET ACR=0
+22 FOR
SET ACR=$ORDER(^ACRAPVS("AB",ACRZDA,ACR))
IF 'ACR
QUIT
IF ACRAPDA'=ACR
IF $DATA(^ACRAPVS(ACR,0))
IF $DATA(^ACRAPVS(ACR,"DT"))
Begin DoDot:1
+23 SET ACRAPV0=^ACRAPVS(ACR,0)
SET ACRAPVDT=^ACRAPVS(ACR,"DT")
+24 IF "^1^2^5^36^40^43^"[(U_+$PIECE(ACRAPV0,U,3)_U)
SET ACRAPVS($PIECE(ACRAPV0,U,3))=U_$SELECT($PIECE(ACRAPVDT,U,6)]"":$PIECE(ACRAPVDT,U,6),1:$PIECE(ACRAPVDT,U,2))_U
+25 IF "^1^2^7^12^14^21^22^23^24^31^37^38^39^45^"'[(U_$PIECE(ACRAPV0,U,3)_U)
IF $PIECE(ACRAPVDT,U,5)'="Y"
IF $PIECE(ACRAPVDT,U)=""
IF $PIECE(ACRAPVDT,U,2)=DUZ
IF $PIECE(ACRAPVDT,U,5)=""
SET ACRSIGN(ACR)=""
End DoDot:1
+26 QUIT
LIST2 ;EP;
+1 SET (ACRXX,ACRMAX)=0
+2 FOR
SET ACRXX=$ORDER(^TMP("ACRDATA",$JOB,ACRDUZ,ACRXX))
IF 'ACRXX!($LENGTH(ACRXX)>8)
QUIT
SET ACRMAX=ACRMAX+1
+3 IF $ORDER(^TMP("ACRDATA",$JOB,ACRDUZ,0))
DO HEAD^ACRFPRC9
+4 SET ACRI=0
+5 FOR
DO LIST21
IF ACRI>0&(ACRI#10=0)
DO PAUSE^ACRFPRC4
IF $DATA(ACRQUIT)!$DATA(ACROUT)!(ACRI#10=0&('$DATA(^TMP("ACRDATA",$JOB,ACRDUZ,ACRI+1))))
QUIT
+6 KILL ACRQUIT
+7 QUIT
LIST21 IF '$DATA(^TMP("ACRDATA",$JOB,ACRDUZ,ACRI+1))
SET ACRQUIT=""
QUIT
+1 NEW X,ACRAPDA
+2 SET ACRI=ACRI+1
+3 SET ACRII=ACRI+10
+4 SET X=^TMP("ACRDATA",$JOB,ACRDUZ,ACRI)
+5 SET ACRDOC=$PIECE(X,U,5)
+6 SET ACRID=$PIECE(X,U,6)
+7 SET ACRAPDA=$PIECE(X,U,4)
+8 WRITE !,$JUSTIFY(ACRI,2)
+9 KILL ACRQUIT
+10 SET X=0
+11 FOR
SET X=$ORDER(^ACRAPVS(ACRAPDA,1,X))
IF 'X
QUIT
IF $DATA(^ACRAPVS(ACRAPDA,1,X,"CNG"))!$DATA(^ACRAPVS(ACRAPDA,1,X,"RSN"))!$DATA(^ACRAPVS(ACRAPDA,1,X,"RESP"))
SET ACRQUIT=""
QUIT
+12 IF $DATA(ACRQUIT)
KILL ACRQUIT
WRITE ?4,"**"
+13 IF $PIECE($GET(^ACRAPVS(+ACRAPDA,0)),U,11)
WRITE ?4,"TA"
+14 IF $PIECE($GET(^ACRDOC(+$GET(^ACRAPVS(+ACRAPDA,0)),0)),U,28)=0
WRITE ?4,"NR"
+15 IF '$TEST
WRITE ?4,$$TOT(+$GET(^ACRAPVS(+ACRAPDA,0)))
+16 WRITE ?7,ACRDOC
+17 WRITE ?24,ACRID
+18 IF '$DATA(^TMP("ACRDATA",$JOB,ACRDUZ,ACRII))
QUIT
+19 SET X=^TMP("ACRDATA",$JOB,ACRDUZ,ACRII)
+20 SET ACRDOC=$PIECE(X,U,5)
+21 SET ACRID=$PIECE(X,U,6)
+22 SET ACRAPDA=$PIECE(X,U,4)
+23 WRITE ?40,"|",$JUSTIFY((ACRII),2)
+24 KILL ACRQUIT
+25 SET X=0
+26 FOR
SET X=$ORDER(^ACRAPVS(ACRAPDA,1,X))
IF 'X
QUIT
IF $DATA(^ACRAPVS(ACRAPDA,1,X,"CNG"))!$DATA(^ACRAPVS(ACRAPDA,1,X,"RSN"))!$DATA(^ACRAPVS(ACRAPDA,1,X,"RESP"))
SET ACRQUIT=""
QUIT
+27 IF $DATA(ACRQUIT)
KILL ACRQUIT
WRITE ?45,"**"
+28 IF $PIECE($GET(^ACRAPVS(+ACRAPDA,0)),U,11)
WRITE ?4,"TA"
+29 IF $PIECE($GET(^ACRDOC(+$GET(^ACRAPVS(+ACRAPDA,0)),0)),U,28)=0
WRITE ?45,"NR"
+30 IF "130^600^"[(U_ACRREF_U)
WRITE ?4,$$TOT(+$GET(^ACRAPVS(+ACRAPDA,0)))
+31 WRITE ?48,ACRDOC
+32 WRITE ?65,ACRID
+33 QUIT
ACRREV ;EP;FOR DOCUMENT APPROVAL
+1 ;CALLED FROM ENTRY ACTION OF ACRMENU
+2 ;ACR*2.1*22.03 IM22653
IF $DATA(ACRNOFM)
QUIT
+3 DO TE^ACRFPRC9
+4 IF $DATA(ACRDOCDA)
SET ACRDOCXX=ACRDOCDA
+5 IF '$DATA(ACRON)
DO HOME^ACRFMENU
+6 SET ACRREV=""
+7 WRITE !!,"One moment, please."
+8 WRITE !!,"I need to review all documents pending for approval"
+9 WRITE !,"to determine if there are any which you need to sign."
+10 WRITE !!
+11 DO EN
+12 KILL ACRREV
+13 IF $DATA(ACRDOCXX)
SET ACRDOCDA=ACRDOCXX
+14 KILL ACRDOCXX
+15 QUIT
ACRCSI ;EP;TO PRINT STATUS OF DOCUMENTS
+1 NEW ACRENTRY
+2 SET ACRENTRY="OBLAMT"
+3 SET ACRENTR1="LOCBAMT"
+4 SET (ACRREV,ACRCSI)=""
+5 DO EN
+6 QUIT
SPSUM ;EP;TO REVIEW SMALL PURCHASE SUMMARY
+1 SET DIR(0)="YO"
+2 SET DIR("A")="Review Small Purchase Summary"
+3 SET DIR("B")="NO"
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF $DATA(ACRQUIT)!$DATA(ACROUT)!(Y'=1)
QUIT
+7 WRITE !!
+8 NEW DXS,DIP,DC,DN
+9 DO ^ACGPSP
+10 DO PAUSE^ACRFWARN
+11 QUIT
TOT(X) ;DETERMINE IF TRAVEL ORDER IS ZERO AMOUNT
+1 IF 'X
QUIT
+2 NEW Y,Z
+3 SET (Y,Z)=0
+4 FOR
SET Y=$ORDER(^ACRSS("J",X,Y))
IF 'Y
QUIT
SET Z=Z+$PIECE($GET(^ACRSS(Y,"DT")),U,4)
+5 IF Z<1
SET Z="ZZ"
+6 IF '$TEST
SET Z=""
+7 QUIT Z
