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
