ACRFPRC9.m

ACRFPRC9 ;IHS/OIRM/DSD/THL,AEF - REVIEW DOCUMENTS FOR APPROVAL WHEN ENTERING KERNEL;  [09/22/2005 11:18 AM]

 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,19**;NOV 05, 2001

 ;;ROUTINE TO ALLOW USER TO SIGN PENDING DOCUMENTS

EN D ACRREV^ACRFPRCS

 Q

EDIT ;EP;

 D ^ACRFDISA

 Q:'$G(ACRAPDA)

 K ACRRR

 S ACRDOCDT=$G(^ACRDOC(ACRDOCDA,"DT")),ACRATTCH=$G(^ACRDOC(ACRDOCDA,3)),ACRATTCH=$P(ACRATTCH,U,9)

 I ACRATTCH>0 D ATTACH^ACRFPRC2

 I $P(ACRDOCDT,U,10)=ACRAPDA D

 .D APDA^ACRFDISA Q

 .N DXS,DIP,DC,DN

 .S D0=ACRAPDA

 .W !!

 .D ^ACRPCNG

 .N DXS,DIP,DC,DN

 .W !!

 .D ^ACRPRSP

 .Q

 S:$P(^ACRAPVS(ACRAPDA,0),U,3)=41 ACRRR="",ACRREFX=499

 I $P(^ACRAPVS(ACRAPDA,0),U,3)=9,$P($G(^ACRAPVS(ACRAPDA,"DT")),U,5)="Y" S ACRTVAL=""

 S DIR(0)="SO^1:Review Document Summary;2:Review Entire Document;3:Skip Document Review"

 S DIR("A")="Type of Review"

 S DIR("B")="Review Document Summary"

 W !

 D DIR^ACRFDIC

 Q:$D(ACRQUIT)!$D(ACROUT)!('$G(Y))

 Q:Y=3

 S:Y=1 ACRPSUM=""

 I $P(^ACRAPVS(ACRAPDA,0),U,11) D  Q

 .D TAFORM^ACRFTA

DISPLAY Q:'$D(^TMP("ACRDATA",$J,ACRDUZ,ACRJJ))

 S ACRREFX=$P(^TMP("ACRDATA",$J,ACRDUZ,ACRJJ),U,2)

 I $P($G(^ACRAPVS(+ACRAPDA,0)),U,4)=99 S ACRREFX=$S(ACRREF=103!(ACRREF=349)!(ACRREF=326)!(ACRREF=210):116,ACRREF=600:130,1:ACRREF)

 S ACRREQST=""

 S:$P(^ACRAPVS(ACRAPDA,0),U,3)=41 ACRRR="",ACRREFX=499

 N ACRDATA

 I '$D(ACRRR)#2 D REQ^ACRFQ I 1

 E  D

 .D DISPLAY^ACRFRR1

 .D PAUSE^ACRFWARN

 K ACRREQST

 I $P(^ACRAPVS(ACRAPDA,0),U,3)=1,$P(^ACRDOC(ACRDOCDA,0),U,16) D

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

 .D SPSUM^ACRFPRCS

 Q

DELETE ;EP;IF DOCUMENT DISAPPROVED, GIVE OFFICIAL OPPORTUNITY TO DELETE THE

 ;DOCUMENT AND RETURN FUNDS TO THE DEPARTMENT ACCOUNT

 D EN3^ACRFDEL

 Q

W ;EP;WRITE DUPLICATE SIGNATURE WARNING

 W !!,*7,*7,"You cannot sign as both ",ACRAPVS,$S("^8^9^21^37^38^39^43^45^"'[(U_ACRAPVT_U):" OFFICIAL",1:"")

 W !,"Another individual with ",$P(ACRAPVS," ")," OFFICIAL authority must sign."

 D PAUSE^ACRFWARN

 S ACRQUIT=""

 Q

CHANGE ;EP;ADD MESSAGE FOR REQUESTED CHANGE

 D NOW^%DTC

 S:'$D(^ACRAPVS(ACRAPDA,1,0)) ^ACRAPVS(ACRAPDA,1,0)="^9002190.01DA"

 S DA(1)=ACRAPDA

 S X=%

 S DIC="^ACRAPVS("_ACRAPDA_",1,"

 S DIC(0)="L"

 S DIC("DR")=".02////"_DUZ

 D FILE^ACRFDIC

 S ^ACRAPVS(ACRAPDA,1,+Y,"CNG")=^ACRAPVS(ACRAPDA,"CNG")

 S ^ACRAPVS(ACRAPDA,1,+Y,"RSN")=^ACRAPVS(ACRAPDA,"RSN")

 Q

HEAD ;EP;

 W @IOF

 W !!,"Select DOCUMENT to REVIEW",$S('$D(ACRCSI):" for APPROVAL",1:""),":"

 W !!?2,"NO."

 W ?7,"DOCUMENT NO."

 W ?24,"IDENTIFIER"

 W ?40,"|  NO."

 W ?48,"DOCUMENT NO."

 W ?65,"IDENTIFIER"

 W !,"------"

 W ?7,"----------------"

 W ?24,"---------------"

 W ?40,"|------"

 W ?48,"----------------"

 W ?65,"---------------"

 Q

TE ;EP;TO NOTIFY ARMS USER THAT THEY HAVE A TRAVEL VOUCHER OR

 ;TRAINING EVALUATION TO COMPLETE

 S ACRDOCDA=0

 K ACRQUIT ;ACR*2.1*3.43

 F  S ACRDOCDA=$O(^ACRDOC("F",DUZ,ACRDOCDA)) Q:'ACRDOCDA!$D(ACROUT)  D

 .I $P($G(^ACROBL(ACRDOCDA,"APV")),U)="A",$P(^("APV"),U,8)="A",'$P($G(^ACRTVAL(ACRDOCDA,0)),U,4) D TEMESS

 I $D(ACRQUIT) K ACRQUIT Q   ;ACR*2.1*3.43

 S ACRDOCDA=0

 F  S ACRDOCDA=$O(^ACRDOC("N",DUZ,ACRDOCDA)) Q:'ACRDOCDA!$D(ACROUT)  D

 .I $P(^ACRDOC(ACRDOCDA,0),U,13)=133,DT>$P($G(^ACRDOC(ACRDOCDA,"TO")),U,15),$E($G(^ACROBL(ACRDOCDA,"APV")))="A",$P(^ACROBL(ACRDOCDA,0),U,6)>2951001 D

 ..K ACRQUIT

 ..S ACRAPDA=0

 ..;EXCLUDE SIGNED VOUCHER ENTRIES                   ;ACR*2.1*19.01  IM17918

 ..;F  S ACRAPDA=$O(^ACRAPVS("AB",ACRDOCDA,ACRAPDA)) Q:'ACRAPDA  I $P($G(^ACRAPVS(ACRAPDA,0)),U,6)=133 S ACRQUIT="" Q  ;ACR*2.1*19.01  IM17918

 ..F  S ACRAPDA=$O(^ACRAPVS("AB",ACRDOCDA,ACRAPDA)) Q:'ACRAPDA  D  Q:$D(ACRQUIT)  ;ACR*2.1*19.01  IM17918

 ...I $P($G(^ACRAPVS(ACRAPDA,0)),U,6)=133,$P(^ACRAPVS(ACRAPDA,"DT"),U,4)]"" S ACRQUIT=""  ;ACR*2.1*19.01  IM17918

 ..I $D(ACRQUIT) K ACRQUIT Q

 ..K ACRQUIT

 ..D TVMESS

 Q

TEMESS ;NOTICE MESSAGE THAT TRAINING EVALUATION IS NOT COMPLETE

 Q:$P($G(^ACRDOC(ACRDOCDA,"TRNG")),U,12)>DT

 Q:$P($G(^ACROBL(ACRDOCDA,"APV")),U)'="A"

 W @IOF

 W *7,*7

 W !!?20,"NOTICE     NOTICE     NOTICE     NOTICE"

 W !!!,"The EVALUATION for TRAINING REQUEST ",$P(^ACRDOC(ACRDOCDA,0),U)," must be completed IMMEDIATELY."

 N ACRTRNG

 S ACRTRNG=$G(^ACRDOC(ACRDOCDA,"TRNG"))

 W !!?10,"COURSE TITLE: ",$P(ACRTRNG,U,18)

 W !?10,"FROM........: "

 S Y=$P(ACRTRNG,U,11)

 X ^DD("DD")

 W Y

 W !?10,"TO..........: "

 S Y=$P(ACRTRNG,U,12)

 X ^DD("DD")

 W Y

 D TR2^ACRFTO

 Q

TVMESS ;NOTICE MESSAGE THAT TRAVEL VOUCHER IS NOT COMPLETE

 Q:$P($G(^ACRDOC(ACRDOCDA,"TO")),U,15)>DT

 W @IOF

 W *7,*7

 W !!?20,"NOTICE     NOTICE     NOTICE     NOTICE"

 W !!!,"TRAVEL VOUCHER ",$P(^ACRDOC(ACRDOCDA,0),U)," (DEPT ACCT ID NO.: ",$P(^(0),U,6)," must be completed IMMEDIATELY."

 S ACRTO=$G(^ACRDOC(ACRDOCDA,"TO"))

 S ACRPDDA=$O(^ACRDOC(ACRDOCDA,9,0))

 S ACRPDDA=+$G(^ACRDOC(ACRDOCDA,9,+ACRPDDA,0))

 S ACRPD=$S(ACRPDDA:$P($G(^ACRPD(ACRPDDA,0)),U),1:"DESTINATION NOT STATED")

 W !!?10,"TRAVEL TO: ",ACRPD

 W !?10,"FROM.....: "

 S Y=$P(ACRTO,U,14)

 X ^DD("DD")

 W Y

 W !?10,"TO.......: "

 S Y=$P(ACRTO,U,15)

 X ^DD("DD")

 W Y

 W !!,"Use 'TV' - Complete Travel Voucher to complete this voucher as soon as possible."

 W !,"This Travel Voucher can be found in DEPARTMENT ACCOUNT ID NO. ",$P(^ACRDOC(ACRDOCDA,0),U,6)

 D PAUSE^ACRFWARN

 K ACRQUIT

 Q

 S DIR(0)="YO"

 S DIR("A")="Do you want to complete the TRAVEL VOUCHER now"

 S DIR("B")="YES"

 W !

 D DIR^ACRFDIC

 Q:$G(Y)'=1

 S ACRENTRY="OBLAMT"

 D SETDOC^ACRFEA1

 D ^ACRFEA41

 Q

ACRFPRC9  ;IHS/OIRM/DSD/THL,AEF - REVIEW DOCUMENTS FOR APPROVAL WHEN ENTERING KERNEL;  [09/22/2005 11:18 AM]

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

 +2       ;;ROUTINE TO ALLOW USER TO SIGN PENDING DOCUMENTS

EN         DO ACRREV^ACRFPRCS

 +1        QUIT 

EDIT      ;EP;

 +1        DO ^ACRFDISA

 +2        IF '$GET(ACRAPDA)

               QUIT 

 +3        KILL ACRRR

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

           SET ACRATTCH=$GET(^ACRDOC(ACRDOCDA,3))

           SET ACRATTCH=$PIECE(ACRATTCH,U,9)

 +5        IF ACRATTCH>0

               DO ATTACH^ACRFPRC2

 +6        IF $PIECE(ACRDOCDT,U,10)=ACRAPDA

               Begin DoDot:1

 +7                DO APDA^ACRFDISA

                   QUIT 

 +8                NEW DXS,DIP,DC,DN

 +9                SET D0=ACRAPDA

 +10               WRITE !!

 +11               DO ^ACRPCNG

 +12               NEW DXS,DIP,DC,DN

 +13               WRITE !!

 +14               DO ^ACRPRSP

 +15               QUIT 

               End DoDot:1

 +16       IF $PIECE(^ACRAPVS(ACRAPDA,0),U,3)=41

               SET ACRRR=""

               SET ACRREFX=499

 +17       IF $PIECE(^ACRAPVS(ACRAPDA,0),U,3)=9

               IF $PIECE($GET(^ACRAPVS(ACRAPDA,"DT")),U,5)="Y"

                   SET ACRTVAL=""

 +18       SET DIR(0)="SO^1:Review Document Summary;2:Review Entire Document;3:Skip Document Review"

 +19       SET DIR("A")="Type of Review"

 +20       SET DIR("B")="Review Document Summary"

 +21       WRITE !

 +22       DO DIR^ACRFDIC

 +23       IF $DATA(ACRQUIT)!$DATA(ACROUT)!('$GET(Y))

               QUIT 

 +24       IF Y=3

               QUIT 

 +25       IF Y=1

               SET ACRPSUM=""

 +26       IF $PIECE(^ACRAPVS(ACRAPDA,0),U,11)

               Begin DoDot:1

 +27               DO TAFORM^ACRFTA

               End DoDot:1

               QUIT 

DISPLAY    IF '$DATA(^TMP("ACRDATA",$JOB,ACRDUZ,ACRJJ))

               QUIT 

 +1        SET ACRREFX=$PIECE(^TMP("ACRDATA",$JOB,ACRDUZ,ACRJJ),U,2)

 +2        IF $PIECE($GET(^ACRAPVS(+ACRAPDA,0)),U,4)=99

               SET ACRREFX=$SELECT(ACRREF=103!(ACRREF=349)!(ACRREF=326)!(ACRREF=210):116,ACRREF=600:130,1:ACRREF)

 +3        SET ACRREQST=""

 +4        IF $PIECE(^ACRAPVS(ACRAPDA,0),U,3)=41

               SET ACRRR=""

               SET ACRREFX=499

 +5        NEW ACRDATA

 +6        IF '$DATA(ACRRR)#2

               DO REQ^ACRFQ

               IF 1

 +7       IF '$TEST

               Begin DoDot:1

 +8                DO DISPLAY^ACRFRR1

 +9                DO PAUSE^ACRFWARN

               End DoDot:1

 +10       KILL ACRREQST

 +11       IF $PIECE(^ACRAPVS(ACRAPDA,0),U,3)=1

               IF $PIECE(^ACRDOC(ACRDOCDA,0),U,16)

                   Begin DoDot:1

 +12                   SET D0=$PIECE(^ACRDOC(ACRDOCDA,0),U,16)

 +13                   DO SPSUM^ACRFPRCS

                   End DoDot:1

 +14       QUIT 

DELETE    ;EP;IF DOCUMENT DISAPPROVED, GIVE OFFICIAL OPPORTUNITY TO DELETE THE

 +1       ;DOCUMENT AND RETURN FUNDS TO THE DEPARTMENT ACCOUNT

 +2        DO EN3^ACRFDEL

 +3        QUIT 

W         ;EP;WRITE DUPLICATE SIGNATURE WARNING

 +1        WRITE !!,*7,*7,"You cannot sign as both ",ACRAPVS,$SELECT("^8^9^21^37^38^39^43^45^"'[(U_ACRAPVT_U):" OFFICIAL",1:"")

 +2        WRITE !,"Another individual with ",$PIECE(ACRAPVS," ")," OFFICIAL authority must sign."

 +3        DO PAUSE^ACRFWARN

 +4        SET ACRQUIT=""

 +5        QUIT 

CHANGE    ;EP;ADD MESSAGE FOR REQUESTED CHANGE

 +1        DO NOW^%DTC

 +2        IF '$DATA(^ACRAPVS(ACRAPDA,1,0))

               SET ^ACRAPVS(ACRAPDA,1,0)="^9002190.01DA"

 +3        SET DA(1)=ACRAPDA

 +4        SET X=%

 +5        SET DIC="^ACRAPVS("_ACRAPDA_",1,"

 +6        SET DIC(0)="L"

 +7        SET DIC("DR")=".02////"_DUZ

 +8        DO FILE^ACRFDIC

 +9        SET ^ACRAPVS(ACRAPDA,1,+Y,"CNG")=^ACRAPVS(ACRAPDA,"CNG")

 +10       SET ^ACRAPVS(ACRAPDA,1,+Y,"RSN")=^ACRAPVS(ACRAPDA,"RSN")

 +11       QUIT 

HEAD      ;EP;

 +1        WRITE @IOF

 +2        WRITE !!,"Select DOCUMENT to REVIEW",$SELECT('$DATA(ACRCSI):" for APPROVAL",1:""),":"

 +3        WRITE !!?2,"NO."

 +4        WRITE ?7,"DOCUMENT NO."

 +5        WRITE ?24,"IDENTIFIER"

 +6        WRITE ?40,"|  NO."

 +7        WRITE ?48,"DOCUMENT NO."

 +8        WRITE ?65,"IDENTIFIER"

 +9        WRITE !,"------"

 +10       WRITE ?7,"----------------"

 +11       WRITE ?24,"---------------"

 +12       WRITE ?40,"|------"

 +13       WRITE ?48,"----------------"

 +14       WRITE ?65,"---------------"

 +15       QUIT 

TE        ;EP;TO NOTIFY ARMS USER THAT THEY HAVE A TRAVEL VOUCHER OR

 +1       ;TRAINING EVALUATION TO COMPLETE

 +2        SET ACRDOCDA=0

 +3       ;ACR*2.1*3.43

           KILL ACRQUIT

 +4        FOR 

               SET ACRDOCDA=$ORDER(^ACRDOC("F",DUZ,ACRDOCDA))

               IF 'ACRDOCDA!$DATA(ACROUT)

                   QUIT 

               Begin DoDot:1

 +5                IF $PIECE($GET(^ACROBL(ACRDOCDA,"APV")),U)="A"

                       IF $PIECE(^("APV"),U,8)="A"

                           IF '$PIECE($GET(^ACRTVAL(ACRDOCDA,0)),U,4)

                               DO TEMESS

               End DoDot:1

 +6       ;ACR*2.1*3.43

           IF $DATA(ACRQUIT)

               KILL ACRQUIT

               QUIT 

 +7        SET ACRDOCDA=0

 +8        FOR 

               SET ACRDOCDA=$ORDER(^ACRDOC("N",DUZ,ACRDOCDA))

               IF 'ACRDOCDA!$DATA(ACROUT)

                   QUIT 

               Begin DoDot:1

 +9                IF $PIECE(^ACRDOC(ACRDOCDA,0),U,13)=133

                       IF DT>$PIECE($GET(^ACRDOC(ACRDOCDA,"TO")),U,15)

                           IF $EXTRACT($GET(^ACROBL(ACRDOCDA,"APV")))="A"

                               IF $PIECE(^ACROBL(ACRDOCDA,0),U,6)>2951001

                                   Begin DoDot:2

 +10                                   KILL ACRQUIT

 +11                                   SET ACRAPDA=0

 +12      ;EXCLUDE SIGNED VOUCHER ENTRIES                   ;ACR*2.1*19.01  IM17918

 +13      ;F  S ACRAPDA=$O(^ACRAPVS("AB",ACRDOCDA,ACRAPDA)) Q:'ACRAPDA  I $P($G(^ACRAPVS(ACRAPDA,0)),U,6)=133 S ACRQUIT="" Q  ;ACR*2.1*19.01  IM17918

 +14      ;ACR*2.1*19.01  IM17918

                                       FOR 

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

                                           IF 'ACRAPDA

                                               QUIT 

                                           Begin DoDot:3

 +15      ;ACR*2.1*19.01  IM17918

                                               IF $PIECE($GET(^ACRAPVS(ACRAPDA,0)),U,6)=133

                                                   IF $PIECE(^ACRAPVS(ACRAPDA,"DT"),U,4)]""

                                                       SET ACRQUIT=""

                                           End DoDot:3

                                           IF $DATA(ACRQUIT)

                                               QUIT 

 +16                                   IF $DATA(ACRQUIT)

                                           KILL ACRQUIT

                                           QUIT 

 +17                                   KILL ACRQUIT

 +18                                   DO TVMESS

                                   End DoDot:2

               End DoDot:1

 +19       QUIT 

TEMESS    ;NOTICE MESSAGE THAT TRAINING EVALUATION IS NOT COMPLETE

 +1        IF $PIECE($GET(^ACRDOC(ACRDOCDA,"TRNG")),U,12)>DT

               QUIT 

 +2        IF $PIECE($GET(^ACROBL(ACRDOCDA,"APV")),U)'="A"

               QUIT 

 +3        WRITE @IOF

 +4        WRITE *7,*7

 +5        WRITE !!?20,"NOTICE     NOTICE     NOTICE     NOTICE"

 +6        WRITE !!!,"The EVALUATION for TRAINING REQUEST ",$PIECE(^ACRDOC(ACRDOCDA,0),U)," must be completed IMMEDIATELY."

 +7        NEW ACRTRNG

 +8        SET ACRTRNG=$GET(^ACRDOC(ACRDOCDA,"TRNG"))

 +9        WRITE !!?10,"COURSE TITLE: ",$PIECE(ACRTRNG,U,18)

 +10       WRITE !?10,"FROM........: "

 +11       SET Y=$PIECE(ACRTRNG,U,11)

 +12       XECUTE ^DD("DD")

 +13       WRITE Y

 +14       WRITE !?10,"TO..........: "

 +15       SET Y=$PIECE(ACRTRNG,U,12)

 +16       XECUTE ^DD("DD")

 +17       WRITE Y

 +18       DO TR2^ACRFTO

 +19       QUIT 

TVMESS    ;NOTICE MESSAGE THAT TRAVEL VOUCHER IS NOT COMPLETE

 +1        IF $PIECE($GET(^ACRDOC(ACRDOCDA,"TO")),U,15)>DT

               QUIT 

 +2        WRITE @IOF

 +3        WRITE *7,*7

 +4        WRITE !!?20,"NOTICE     NOTICE     NOTICE     NOTICE"

 +5        WRITE !!!,"TRAVEL VOUCHER ",$PIECE(^ACRDOC(ACRDOCDA,0),U)," (DEPT ACCT ID NO.: ",$PIECE(^(0),U,6)," must be completed IMMEDIATELY."

 +6        SET ACRTO=$GET(^ACRDOC(ACRDOCDA,"TO"))

 +7        SET ACRPDDA=$ORDER(^ACRDOC(ACRDOCDA,9,0))

 +8        SET ACRPDDA=+$GET(^ACRDOC(ACRDOCDA,9,+ACRPDDA,0))

 +9        SET ACRPD=$SELECT(ACRPDDA:$PIECE($GET(^ACRPD(ACRPDDA,0)),U),1:"DESTINATION NOT STATED")

 +10       WRITE !!?10,"TRAVEL TO: ",ACRPD

 +11       WRITE !?10,"FROM.....: "

 +12       SET Y=$PIECE(ACRTO,U,14)

 +13       XECUTE ^DD("DD")

 +14       WRITE Y

 +15       WRITE !?10,"TO.......: "

 +16       SET Y=$PIECE(ACRTO,U,15)

 +17       XECUTE ^DD("DD")

 +18       WRITE Y

 +19       WRITE !!,"Use 'TV' - Complete Travel Voucher to complete this voucher as soon as possible."

 +20       WRITE !,"This Travel Voucher can be found in DEPARTMENT ACCOUNT ID NO. ",$PIECE(^ACRDOC(ACRDOCDA,0),U,6)

 +21       DO PAUSE^ACRFWARN

 +22       KILL ACRQUIT

 +23       QUIT 

 +24       SET DIR(0)="YO"

 +25       SET DIR("A")="Do you want to complete the TRAVEL VOUCHER now"

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

 +27       WRITE !

 +28       DO DIR^ACRFDIC

 +29       IF $GET(Y)'=1

               QUIT 

 +30       SET ACRENTRY="OBLAMT"

 +31       DO SETDOC^ACRFEA1

 +32       DO ^ACRFEA41

 +33       QUIT