ACRFPRC4.m

ACRFPRC4 ;IHS/OIRM/DSD/THL,AEF - PROCESS PENDING DOCUMENTS;  [ 11/01/2001   9:44 AM ]

 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001

 ;;CONTINUATION OF ACRFPRCS

PONUM ;EP;

 N ACRFY

 S ACRNUM=$P(ACRDOC0,U,2)

 I ACRNUM]"",ACRNUM'["PENDING" Q

 Q:$E(ACRNUM,7,10)?4N

 S ACRPODA=$P(ACRDOC0,U,8)

 S ACRFY=$P(^ACRLOCB($P(ACRDOC0,U,6),"DT"),U)

 N S

 S X=^ACRPO(ACRPODA,0)

 S ACRAPT=$P(X,U,4)

 S ACRLC=$P(X,U,5)

 S ACRAREA=$P(X,U,10)

 S ACRFYX=$S(+$E(DT,4,5)<10:DT\10000,1:DT\10000+1)+1700

 S ACRFYX=$S(ACRFYX>ACRFY:ACRFYX,1:ACRFY)

 I ACRAPVT'=1 S ACRNUM="PENDING"

 S ACRNUM=$E(ACRFYX,4)_$E($P(^AUTTLCOD(ACRLC,0),U),1,3)_ACRNUM

 Q

PONUM1 ;EP;

 S ACRNUM=$P(ACRDOC0,U,2)

 I ACRNUM]"",ACRNUM'["PENDING" Q

 Q:$E(ACRNUM,7,10)?4N

 I $P(ACRDOC0,U,15),$P($G(^ACRDOC(+$P(ACRDOC0,U,15),0)),U,2)]"" S ACRNUM=$P(^(0),U,2) Q

 S ACRFY=$P(^ACRLOCB($P(ACRDOC0,U,6),"DT"),U)

 S ACRFYX=$S(+$E(DT,4,5)<10:DT\10000,1:DT\10000+1)+1700

 S ACRFYX=$S(ACRFYX>ACRFY:ACRFYX,1:ACRFY)

 I '$D(^ACRPO(ACRPODA,1,0)) S ^ACRPO(ACRPODA,1,0)="^9002199.41"

 I '$D(^ACRPO(ACRPODA,1,"B",ACRFYX)) D

 .S DA(1)=ACRPODA

 .S (X,DINUM)=ACRFYX

 .S DIC="^ACRPO("_DA(1)_",1,"

 .S DIC(0)="L"

 .D FILE^ACRFDIC

 L +^ACRPO(ACRPODA):2

 I $T=1 D  I 1

 .S ACRNUM=$P(^ACRPO(ACRPODA,1,ACRFYX,0),U,2)

 .S ACRNUM=ACRNUM+1

 .S $P(^ACRPO(ACRPODA,1,ACRFYX,0),U,2)=ACRNUM

 .L -^ACRPO(ACRPODA):0

 E  G PONUM1

 F ACRJI=1:1:(4-$L(ACRNUM)) S ACRNUM="0"_ACRNUM

 S ACRLC=$P(^ACRPO(ACRPODA,0),U,5)

 S ACRNUM=$E(ACRFYX,4)_$E($P(^AUTTLCOD(ACRLC,0),U),1,3)_ACRNUM_$S('$P(^ACRDOC(ACRDOCDA,0),U,18):"00",1:"BP")

 I "^103^210^"[(U_ACRREF_U),$D(^ACRDOC("B",ACRNUM))!$D(^ACRDOC("C",ACRNUM)) G PONUM1

 K ACRTXDAX

 D NOW^%DTC

 S DA=ACRDOCDA

 S DIE="^ACRDOC("

 S DR=".02////"_ACRNUM_";.5////"_%

 D DIE^ACRFDIC

 N ACRX

 S ACRX=0

 F  S ACRX=$O(^ACRDOC("MOD",ACRDOCDA,ACRX)) Q:'ACRX  D

 .S DA=ACRDOCDA

 .S DIE="^ACRDOC("

 .S DR=".02////"_ACRNUM

 .D DIE^ACRFDIC

 S DA=$P(^ACRDOC(ACRDOCDA,0),U,16)

 S DIE="^ACGS("

 S DR="2////"_ACRNUM

 D:DA DIE^ACRFDIC

 Q

PAUSE ;EP;

 S ACRI=ACRI+10

 I '$D(^TMP("ACRDATA",$J,ACRDUZ,ACRI+1)) S ACRQUIT="" Q

 K ACRQUIT

 S DIR(0)="YO"

 S DIR("A")="Display more documents"

 S DIR("B")="YES"

 W !

 D DIR^ACRFDIC

 I Y=1 W ! Q

 S ACRQUIT=""

 Q

RELIST ;EP;RELISTS DOCUMENTS FOR CURRENT USER TO SIGN

 I $D(^TMP("ACRDATE",$J)) D R1 Q

 S ACR=0

 F ACRI=1:1 S ACR=$O(^TMP("ACRDATA",$J,ACRDUZ,ACR)) Q:'ACR!($L(ACR)>8)  I ACRI<ACR D

 .S ^TMP("ACRDATA",$J,ACRDUZ,ACRI)=^TMP("ACRDATA",$J,ACRDUZ,ACR)

 .N ACRDOC

 .S ACRDOC=$P(^TMP("ACRDATA",$J,ACRDUZ,ACR),U,5)

 .S ^TMP("ACRDATA",$J,ACRDUZ,ACRDOC)=^TMP("ACRDATA",$J,ACRDUZ,ACR)

 .S $P(^TMP("ACRDATA",$J,ACRDUZ,ACRDOC),U,10)=ACRI

 .K ^TMP("ACRDATA",$J,ACRDUZ,ACR)

 Q

R1 ;CHANGE DATE ORDER ARRAY TO NUMERIC ORDERED ARRAY

 S (ACR,ACRI)=0

 F  S ACR=$O(^TMP("ACRDATE",$J,ACRDUZ,ACR)) Q:'ACR  D

 .S ACR1=0

 .F  S ACR1=$O(^TMP("ACRDATE",$J,ACRDUZ,ACR,ACR1)) Q:'ACR1!($L(ACR1)>8)  D

 ..S ACRI=ACRI+1

 ..S ^TMP("ACRDATA",$J,ACRDUZ,ACRI)=^TMP("ACRDATE",$J,ACRDUZ,ACR,ACR1)

 ..N ACRDOC

 ..S ACRDOC=$P(^TMP("ACRDATE",$J,ACRDUZ,ACR,ACR1),U,5)

 ..S ^TMP("ACRDATA",$J,ACRDUZ,ACRDOC)=^TMP("ACRDATE",$J,ACRDUZ,ACR,ACR1)

 ..S $P(^TMP("ACRDATA",$J,ACRDUZ,ACRDOC),U,10)=ACRI

 ..K ^TMP("ACRDATE",$J,ACRDUZ,ACR,ACR1)

 K ^TMP("ACRDATE",$J)

 Q

RECERT ;EP;PROCESS RECERT OF FUNDS

 S ACRFINAL="N"

 S ACRORDER=99

 S ACRLBDA=$P(ACRDOC0,U,6)

 S ACRUSER=+^ACRDOC(ACRDOCDA,"FA")

 S ACRDATE=$E(DT,1,3)_"1001"

 S ACRRDATE=ACRDATE

 K ACRQUIT

 N X,Y,Z

 S X=0

 F  S X=$O(^ACRAPVS("AB",ACRDOCDA,X)) Q:'X!$D(ACRQUIT)  D

 .S Y=$G(^ACRAPVS(X,0))

 .S Z=$G(^ACRAPVS(X,"DT"))

 .I $P(Z,U,8)=ACRDATE S ACRQUIT=""

 I $D(ACRQUIT) K ACRQUIT Q

 D SETAPP^ACRFAPVS

 S ^ACRAPVS("ANXT",ACRAPVT,ACRUSER,+Y)=ACRDOCDA

 Q

38 ;EP;ENTER TREASURY SCHEDULE NUMBER FOR THE TRAVEL VOUCHER PAYMENT

 S DA=ACRDOCDA

 S DIE="^ACRDOC("

 S DR="28T;29.5T;29T"

 S:$P($G(^ACRSYS(1,"DT1")),U,9)>1 DR="29.5T;29T"

 W !

 D DIE^ACRFDIC

 I $P(^ACRSYS(ACRADA,"DT"),U,34)<1,$P(^("DT"),U,33) D

 .W !,"The systems indicates the AIRFARE will be paid separately."

 .S DA=ACRDOCDA

 .S DIE="^ACROBL("

 .S DR="912T//PARTIAL"

 .D DIE^ACRFDIC

 I $P($G(^ACRDOC(ACRDOCDA,18)),U,3)="" D

 .W *7,*7

 .W !!,"The PAYMENT/COLLECTION DOCUMENT # (Treasury Schedule #) is required."

 .W !,"This TRAVEL VOUCHER can be signed and completed when the required"

 .W !,"information is available."

 .D PAUSE^ACRFWARN

 .S ACRQUIT=""

 Q

LIST ;EP;CREATE LIST OF DOCUMENTS FOR USER TO APPROVE

 N ACRDOCDA,ACRDOC0

 S ACRDOCDA=+ACRAP0

 Q:'$D(^ACRDOC(ACRDOCDA,0))

 S ACRDOC0=^ACRDOC(ACRDOCDA,0)

 S ACRDOCDT=$G(^ACRDOC(ACRDOCDA,"DT"))

 S ACRDOC=$P(ACRDOC0,U)

 S ACRTXTYP=$P(ACRDOC0,U,4)

 I +ACRDOCDT,'$P(ACRDOCDT,U,2) Q

 I $D(ACRCSI),$D(ACRTXDA),ACRTXDA'=ACRTXTYP S ACRI=ACRI-1 Q

 S ACRI=ACRI+1

 S ACRLBDA=","_$P(ACRDOC0,U,6)_","

 S ACRREF=$P(ACRDOC0,U,13)

 S ACRREF1=$P(^AUTTDOCR(ACRREF,0),U)

 S ACRID=$E($P(ACRDOC0,U,14),1,15)

 I DUZ'=ACRINDV S ^TMP("ACRALTDT",$J,ACRINDV,ACRDATE,ACRI)=ACRDOCDA_U_ACRREF1_U_ACRTXTYP_U_ACRAPDA_U_ACRDOC_U_ACRID

 E  S:$S>10000 ^TMP("ACRDATE",$J,DUZ,ACRDATE,ACRI)=ACRDOCDA_U_ACRREF1_U_ACRTXTYP_U_ACRAPDA_U_ACRDOC_U_ACRID

 Q

TREPORT ;EP;REVIEW TRAVEL REPORT

 S DIR(0)="YO"

 S DIR("A")="Review Trip Report"

 S DIR("B")="NO"

 W !

 D DIR^ACRFDIC

 Q:$G(Y)'=1

 S ACRPTR=""

 D PTR^ACRFTO

 Q

CERT ;EP;CHECKS WHETHER THERE ARE APPLICABLE CERTIFICATIONS FOR TYPE

 ;OF APPROVAL AND TYPE OF TRANSACTION AND ALLOWS FOR SELECTION

 ;AND PROCESSING OF CERTIFICATIONS.

 I $D(^ACRAPVC("AC",ACRAPVT,ACRTXTYP)) D DOCCERT^ACRFCERT

 Q

ESIG ;EP;RECORD ELECTRONIC SIGNATURE PRIOR TO SIGNING DOCUMENTS

 W @IOF

 W !,"You have documents which are pending for your signature."

 W !!,"Enter your electronic signature to review documents now."

 W !!,"Enter '^' to bypass document review."

 W !

 D ^ACRFESIG

 Q

CONFIRM ;EP;CONFIRM THAT YOU WANT TO APPROVE A DOCUMENT

 W !

 S DIR(0)="YO"

 S DIR("A",1)="Apply my AUTHORIZED signature to "_$S(ACRAPDAS="A":"APPROVE",1:"DISAPPROVE")

 S DIR("A")="document NO.: "_ACRDOC

 S DIR("B")="YES"

 D DIR^ACRFDIC

 S:$G(Y)'=1 ACRQUIT=""

 Q

SECURITY ;EP;PRINT SIGNATURE SECURITY MESSGE

 W @IOF

 D WARNING^ACRFWARN

 W !!,"To PREVENT UNAUTHORIZED ACCESS to documents pending your approval,"

 W !,"NEVER LEAVE your computer UNATTENDED during the DOUMENT REVIEW process."

 D PAUSE^ACRFWARN

 Q

ACRFPRC4  ;IHS/OIRM/DSD/THL,AEF - PROCESS PENDING DOCUMENTS;  [ 11/01/2001   9:44 AM ]

 +1       ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001

 +2       ;;CONTINUATION OF ACRFPRCS

PONUM     ;EP;

 +1        NEW ACRFY

 +2        SET ACRNUM=$PIECE(ACRDOC0,U,2)

 +3        IF ACRNUM]""

               IF ACRNUM'["PENDING"

                   QUIT 

 +4        IF $EXTRACT(ACRNUM,7,10)?4N

               QUIT 

 +5        SET ACRPODA=$PIECE(ACRDOC0,U,8)

 +6        SET ACRFY=$PIECE(^ACRLOCB($PIECE(ACRDOC0,U,6),"DT"),U)

 +7        NEW S

 +8        SET X=^ACRPO(ACRPODA,0)

 +9        SET ACRAPT=$PIECE(X,U,4)

 +10       SET ACRLC=$PIECE(X,U,5)

 +11       SET ACRAREA=$PIECE(X,U,10)

 +12       SET ACRFYX=$SELECT(+$EXTRACT(DT,4,5)<10:DT\10000,1:DT\10000+1)+1700

 +13       SET ACRFYX=$SELECT(ACRFYX>ACRFY:ACRFYX,1:ACRFY)

 +14       IF ACRAPVT'=1

               SET ACRNUM="PENDING"

 +15       SET ACRNUM=$EXTRACT(ACRFYX,4)_$EXTRACT($PIECE(^AUTTLCOD(ACRLC,0),U),1,3)_ACRNUM

 +16       QUIT 

PONUM1    ;EP;

 +1        SET ACRNUM=$PIECE(ACRDOC0,U,2)

 +2        IF ACRNUM]""

               IF ACRNUM'["PENDING"

                   QUIT 

 +3        IF $EXTRACT(ACRNUM,7,10)?4N

               QUIT 

 +4        IF $PIECE(ACRDOC0,U,15)

               IF $PIECE($GET(^ACRDOC(+$PIECE(ACRDOC0,U,15),0)),U,2)]""

                   SET ACRNUM=$PIECE(^(0),U,2)

                   QUIT 

 +5        SET ACRFY=$PIECE(^ACRLOCB($PIECE(ACRDOC0,U,6),"DT"),U)

 +6        SET ACRFYX=$SELECT(+$EXTRACT(DT,4,5)<10:DT\10000,1:DT\10000+1)+1700

 +7        SET ACRFYX=$SELECT(ACRFYX>ACRFY:ACRFYX,1:ACRFY)

 +8        IF '$DATA(^ACRPO(ACRPODA,1,0))

               SET ^ACRPO(ACRPODA,1,0)="^9002199.41"

 +9        IF '$DATA(^ACRPO(ACRPODA,1,"B",ACRFYX))

               Begin DoDot:1

 +10               SET DA(1)=ACRPODA

 +11               SET (X,DINUM)=ACRFYX

 +12               SET DIC="^ACRPO("_DA(1)_",1,"

 +13               SET DIC(0)="L"

 +14               DO FILE^ACRFDIC

               End DoDot:1

 +15       LOCK +^ACRPO(ACRPODA):2

 +16       IF $TEST=1

               Begin DoDot:1

 +17               SET ACRNUM=$PIECE(^ACRPO(ACRPODA,1,ACRFYX,0),U,2)

 +18               SET ACRNUM=ACRNUM+1

 +19               SET $PIECE(^ACRPO(ACRPODA,1,ACRFYX,0),U,2)=ACRNUM

 +20               LOCK -^ACRPO(ACRPODA):0

               End DoDot:1

               IF 1

 +21      IF '$TEST

               GOTO PONUM1

 +22       FOR ACRJI=1:1:(4-$LENGTH(ACRNUM))

               SET ACRNUM="0"_ACRNUM

 +23       SET ACRLC=$PIECE(^ACRPO(ACRPODA,0),U,5)

 +24       SET ACRNUM=$EXTRACT(ACRFYX,4)_$EXTRACT($PIECE(^AUTTLCOD(ACRLC,0),U),1,3)_ACRNUM_$SELECT('$PIECE(^ACRDOC(ACRDOCDA,0),U,18):"00",1:"BP")

 +25       IF "^103^210^"[(U_ACRREF_U)

               IF $DATA(^ACRDOC("B",ACRNUM))!$DATA(^ACRDOC("C",ACRNUM))

                   GOTO PONUM1

 +26       KILL ACRTXDAX

 +27       DO NOW^%DTC

 +28       SET DA=ACRDOCDA

 +29       SET DIE="^ACRDOC("

 +30       SET DR=".02////"_ACRNUM_";.5////"_%

 +31       DO DIE^ACRFDIC

 +32       NEW ACRX

 +33       SET ACRX=0

 +34       FOR 

               SET ACRX=$ORDER(^ACRDOC("MOD",ACRDOCDA,ACRX))

               IF 'ACRX

                   QUIT 

               Begin DoDot:1

 +35               SET DA=ACRDOCDA

 +36               SET DIE="^ACRDOC("

 +37               SET DR=".02////"_ACRNUM

 +38               DO DIE^ACRFDIC

               End DoDot:1

 +39       SET DA=$PIECE(^ACRDOC(ACRDOCDA,0),U,16)

 +40       SET DIE="^ACGS("

 +41       SET DR="2////"_ACRNUM

 +42       IF DA

               DO DIE^ACRFDIC

 +43       QUIT 

PAUSE     ;EP;

 +1        SET ACRI=ACRI+10

 +2        IF '$DATA(^TMP("ACRDATA",$JOB,ACRDUZ,ACRI+1))

               SET ACRQUIT=""

               QUIT 

 +3        KILL ACRQUIT

 +4        SET DIR(0)="YO"

 +5        SET DIR("A")="Display more documents"

 +6        SET DIR("B")="YES"

 +7        WRITE !

 +8        DO DIR^ACRFDIC

 +9        IF Y=1

               WRITE !

               QUIT 

 +10       SET ACRQUIT=""

 +11       QUIT 

RELIST    ;EP;RELISTS DOCUMENTS FOR CURRENT USER TO SIGN

 +1        IF $DATA(^TMP("ACRDATE",$JOB))

               DO R1

               QUIT 

 +2        SET ACR=0

 +3        FOR ACRI=1:1

               SET ACR=$ORDER(^TMP("ACRDATA",$JOB,ACRDUZ,ACR))

               IF 'ACR!($LENGTH(ACR)>8)

                   QUIT 

               IF ACRI<ACR

                   Begin DoDot:1

 +4                    SET ^TMP("ACRDATA",$JOB,ACRDUZ,ACRI)=^TMP("ACRDATA",$JOB,ACRDUZ,ACR)

 +5                    NEW ACRDOC

 +6                    SET ACRDOC=$PIECE(^TMP("ACRDATA",$JOB,ACRDUZ,ACR),U,5)

 +7                    SET ^TMP("ACRDATA",$JOB,ACRDUZ,ACRDOC)=^TMP("ACRDATA",$JOB,ACRDUZ,ACR)

 +8                    SET $PIECE(^TMP("ACRDATA",$JOB,ACRDUZ,ACRDOC),U,10)=ACRI

 +9                    KILL ^TMP("ACRDATA",$JOB,ACRDUZ,ACR)

                   End DoDot:1

 +10       QUIT 

R1        ;CHANGE DATE ORDER ARRAY TO NUMERIC ORDERED ARRAY

 +1        SET (ACR,ACRI)=0

 +2        FOR 

               SET ACR=$ORDER(^TMP("ACRDATE",$JOB,ACRDUZ,ACR))

               IF 'ACR

                   QUIT 

               Begin DoDot:1

 +3                SET ACR1=0

 +4                FOR 

                       SET ACR1=$ORDER(^TMP("ACRDATE",$JOB,ACRDUZ,ACR,ACR1))

                       IF 'ACR1!($LENGTH(ACR1)>8)

                           QUIT 

                       Begin DoDot:2

 +5                        SET ACRI=ACRI+1

 +6                        SET ^TMP("ACRDATA",$JOB,ACRDUZ,ACRI)=^TMP("ACRDATE",$JOB,ACRDUZ,ACR,ACR1)

 +7                        NEW ACRDOC

 +8                        SET ACRDOC=$PIECE(^TMP("ACRDATE",$JOB,ACRDUZ,ACR,ACR1),U,5)

 +9                        SET ^TMP("ACRDATA",$JOB,ACRDUZ,ACRDOC)=^TMP("ACRDATE",$JOB,ACRDUZ,ACR,ACR1)

 +10                       SET $PIECE(^TMP("ACRDATA",$JOB,ACRDUZ,ACRDOC),U,10)=ACRI

 +11                       KILL ^TMP("ACRDATE",$JOB,ACRDUZ,ACR,ACR1)

                       End DoDot:2

               End DoDot:1

 +12       KILL ^TMP("ACRDATE",$JOB)

 +13       QUIT 

RECERT    ;EP;PROCESS RECERT OF FUNDS

 +1        SET ACRFINAL="N"

 +2        SET ACRORDER=99

 +3        SET ACRLBDA=$PIECE(ACRDOC0,U,6)

 +4        SET ACRUSER=+^ACRDOC(ACRDOCDA,"FA")

 +5        SET ACRDATE=$EXTRACT(DT,1,3)_"1001"

 +6        SET ACRRDATE=ACRDATE

 +7        KILL ACRQUIT

 +8        NEW X,Y,Z

 +9        SET X=0

 +10       FOR 

               SET X=$ORDER(^ACRAPVS("AB",ACRDOCDA,X))

               IF 'X!$DATA(ACRQUIT)

                   QUIT 

               Begin DoDot:1

 +11               SET Y=$GET(^ACRAPVS(X,0))

 +12               SET Z=$GET(^ACRAPVS(X,"DT"))

 +13               IF $PIECE(Z,U,8)=ACRDATE

                       SET ACRQUIT=""

               End DoDot:1

 +14       IF $DATA(ACRQUIT)

               KILL ACRQUIT

               QUIT 

 +15       DO SETAPP^ACRFAPVS

 +16       SET ^ACRAPVS("ANXT",ACRAPVT,ACRUSER,+Y)=ACRDOCDA

 +17       QUIT 

38        ;EP;ENTER TREASURY SCHEDULE NUMBER FOR THE TRAVEL VOUCHER PAYMENT

 +1        SET DA=ACRDOCDA

 +2        SET DIE="^ACRDOC("

 +3        SET DR="28T;29.5T;29T"

 +4        IF $PIECE($GET(^ACRSYS(1,"DT1")),U,9)>1

               SET DR="29.5T;29T"

 +5        WRITE !

 +6        DO DIE^ACRFDIC

 +7        IF $PIECE(^ACRSYS(ACRADA,"DT"),U,34)<1

               IF $PIECE(^("DT"),U,33)

                   Begin DoDot:1

 +8                    WRITE !,"The systems indicates the AIRFARE will be paid separately."

 +9                    SET DA=ACRDOCDA

 +10                   SET DIE="^ACROBL("

 +11                   SET DR="912T//PARTIAL"

 +12                   DO DIE^ACRFDIC

                   End DoDot:1

 +13       IF $PIECE($GET(^ACRDOC(ACRDOCDA,18)),U,3)=""

               Begin DoDot:1

 +14               WRITE *7,*7

 +15               WRITE !!,"The PAYMENT/COLLECTION DOCUMENT # (Treasury Schedule #) is required."

 +16               WRITE !,"This TRAVEL VOUCHER can be signed and completed when the required"

 +17               WRITE !,"information is available."

 +18               DO PAUSE^ACRFWARN

 +19               SET ACRQUIT=""

               End DoDot:1

 +20       QUIT 

LIST      ;EP;CREATE LIST OF DOCUMENTS FOR USER TO APPROVE

 +1        NEW ACRDOCDA,ACRDOC0

 +2        SET ACRDOCDA=+ACRAP0

 +3        IF '$DATA(^ACRDOC(ACRDOCDA,0))

               QUIT 

 +4        SET ACRDOC0=^ACRDOC(ACRDOCDA,0)

 +5        SET ACRDOCDT=$GET(^ACRDOC(ACRDOCDA,"DT"))

 +6        SET ACRDOC=$PIECE(ACRDOC0,U)

 +7        SET ACRTXTYP=$PIECE(ACRDOC0,U,4)

 +8        IF +ACRDOCDT

               IF '$PIECE(ACRDOCDT,U,2)

                   QUIT 

 +9        IF $DATA(ACRCSI)

               IF $DATA(ACRTXDA)

                   IF ACRTXDA'=ACRTXTYP

                       SET ACRI=ACRI-1

                       QUIT 

 +10       SET ACRI=ACRI+1

 +11       SET ACRLBDA=","_$PIECE(ACRDOC0,U,6)_","

 +12       SET ACRREF=$PIECE(ACRDOC0,U,13)

 +13       SET ACRREF1=$PIECE(^AUTTDOCR(ACRREF,0),U)

 +14       SET ACRID=$EXTRACT($PIECE(ACRDOC0,U,14),1,15)

 +15       IF DUZ'=ACRINDV

               SET ^TMP("ACRALTDT",$JOB,ACRINDV,ACRDATE,ACRI)=ACRDOCDA_U_ACRREF1_U_ACRTXTYP_U_ACRAPDA_U_ACRDOC_U_ACRID

 +16      IF '$TEST

               IF $STORAGE>10000

                   SET ^TMP("ACRDATE",$JOB,DUZ,ACRDATE,ACRI)=ACRDOCDA_U_ACRREF1_U_ACRTXTYP_U_ACRAPDA_U_ACRDOC_U_ACRID

 +17       QUIT 

TREPORT   ;EP;REVIEW TRAVEL REPORT

 +1        SET DIR(0)="YO"

 +2        SET DIR("A")="Review Trip Report"

 +3        SET DIR("B")="NO"

 +4        WRITE !

 +5        DO DIR^ACRFDIC

 +6        IF $GET(Y)'=1

               QUIT 

 +7        SET ACRPTR=""

 +8        DO PTR^ACRFTO

 +9        QUIT 

CERT      ;EP;CHECKS WHETHER THERE ARE APPLICABLE CERTIFICATIONS FOR TYPE

 +1       ;OF APPROVAL AND TYPE OF TRANSACTION AND ALLOWS FOR SELECTION

 +2       ;AND PROCESSING OF CERTIFICATIONS.

 +3        IF $DATA(^ACRAPVC("AC",ACRAPVT,ACRTXTYP))

               DO DOCCERT^ACRFCERT

 +4        QUIT 

ESIG      ;EP;RECORD ELECTRONIC SIGNATURE PRIOR TO SIGNING DOCUMENTS

 +1        WRITE @IOF

 +2        WRITE !,"You have documents which are pending for your signature."

 +3        WRITE !!,"Enter your electronic signature to review documents now."

 +4        WRITE !!,"Enter '^' to bypass document review."

 +5        WRITE !

 +6        DO ^ACRFESIG

 +7        QUIT 

CONFIRM   ;EP;CONFIRM THAT YOU WANT TO APPROVE A DOCUMENT

 +1        WRITE !

 +2        SET DIR(0)="YO"

 +3        SET DIR("A",1)="Apply my AUTHORIZED signature to "_$SELECT(ACRAPDAS="A":"APPROVE",1:"DISAPPROVE")

 +4        SET DIR("A")="document NO.: "_ACRDOC

 +5        SET DIR("B")="YES"

 +6        DO DIR^ACRFDIC

 +7        IF $GET(Y)'=1

               SET ACRQUIT=""

 +8        QUIT 

SECURITY  ;EP;PRINT SIGNATURE SECURITY MESSGE

 +1        WRITE @IOF

 +2        DO WARNING^ACRFWARN

 +3        WRITE !!,"To PREVENT UNAUTHORIZED ACCESS to documents pending your approval,"

 +4        WRITE !,"NEVER LEAVE your computer UNATTENDED during the DOUMENT REVIEW process."

 +5        DO PAUSE^ACRFWARN

 +6        QUIT