ACRFPRCS.m

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