ACRFTO ;IHS/OIRM/DSD/THL,AEF - TRAVEL ORDER PROCESSING; [ 09/26/2005 11:20 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,19**;NOV 05, 2001
;;ROUTINE USED TO PROCESS TRAVEL ORDERS
EN K ACRQUIT,ACRUCHK,ACRTXDA
F D EN1 Q:$D(ACRQUIT)!$D(ACROUT)
EXIT K ACRX,ACRDOC,ACRREF,ACRTXTYP,ACRDOC1,ACRMAX,ACRAPVT,ACRQUIT,ACRDA,ACRDOCDA,ACRENTRY,ACRGREF,ACRDOCDA,ACRREF1,ACRY,ACRAPDA,ACRLBDA,ACRNOW,ACRNUM,ACRORD,ACRREFDA,ACRSIG,ACRSIGG,ACRPRT,ACRCOMP,ACRURTV,ACRTPALL,ACRTPAR
K ACRSIGP,ACRSIGZ,ACRSIGZZ,ACRFDNO(1),ACRPOA,ACRPO,ACRPPO,ACRPA,ACRXMY
Q
EN1 ;EP;
K ACRDOCDA,DIC
D SELDOC
I '$G(ACRDOCDA) S ACRQUIT="" Q
Q:$D(ACRTPAR)
I ACRREFX=130 D Q:$D(ACRQUIT)!$D(ACROUT)
.S DIR(0)="YO"
.S DIR("A")="Include Travel Expense Summary"
.S DIR("B")="NO"
.W !
.D DIR^ACRFDIC
.I +Y'=1 S ACRDAILY=""
I ACRREFX=148,(ACRID'["CANCELLED") D Q:$D(ACRQUIT)!$D(ACROUT) ;ACR*2.1*3.23
.S DIR(0)="YO"
.S DIR("A")="Include Training Evaluation"
.S DIR("B")="NO"
.W !
.D DIR^ACRFDIC
.Q:$D(ACROUT)
.I +Y=1 S ACRTVAL=""
.I $D(^ACRTPAR("C",ACRDOCDA)) D Q:$D(ACRQUIT)!$D(ACROUT)
..K ACRTPALL
..S DIR(0)="YO"
..S DIR("A")="Print PERSONNEL FILE Copy of the 350 for each Participant"
..S DIR("B")="NO"
..W !
..D DIR^ACRFDIC
..I +Y=1 S ACRTPALL=""
I ACRREFX'=148 D Q:$D(ACRQUIT)!$D(ACROUT)
.S DIR(0)="YO"
.S DIR("A")="Include Travel Itinerary"
.S DIR("B")="NO"
.W !
.D DIR^ACRFDIC
.Q:$D(ACRQUIT)!$D(ACROUT)
.I +Y'=1 S ACRITINY=""
I ACRREFX=600,$D(^ACROBL(ACRDOCDA,2)) D Q:$D(ACRQUIT)!$D(ACROUT)
.S DIR(0)="YO"
.S DIR("A")="Include Trip Report"
.S DIR("B")="NO"
.W !
.D DIR^ACRFDIC
.I +Y=1 S ACRPTR=""
I $D(ACRTPALL) D ^ACRFTPA1,EXIT Q
D REQ^ACRFQ
I $D(ACRPTR) D PTR ;ACR*2.1*3.22
K ACRQUIT,ACRREQST,ACRDAILY,ACRITINY,ACRTVAL
Q
TRAIN ;EP;TO SELECT THE TRAINING DOCUMENT AND COMPLETE THE TRAINING
;;EVALUATION
K ACRQUIT
F D TR1 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
Q
TR1 W @IOF
W !?20,"SELECT THE TRAINING DOCUMENT"
S DIC="^ACRDOC("
S DIC(0)="AEMQZ"
S DIC("A")="Select TRAINING DOCUMENT (350): "
S DIC("S")="I $P($G(^ACRDOC(+Y,""TRNG"")),U,2)=DUZ"
S DIC("S")=DIC("S")_" I $P($G(^ACROBL(+Y,""APV"")),U)=""A"""
S D="B^G^R"
W !!
D MIX^ACRFDIC
I +Y<1!$D(ACRQUIT)!$D(ACROUT) S ACRQUIT="" Q
S ACRDOCDA=+Y
S ACRCOMP=""
S ACRREF=148
TR2 ;EP;TO COMPLETE TRAINING EVALUATION
S DIR(0)="SO^1:Complete Training Evaluation;2:Cancel Training Order" ;ACR*2.1*3.16
S DIR("A")="Which Action"
W !
D DIR^ACRFDIC
Q:Y<1
D SETDOC^ACRFEA1
I Y=2 S ACRCANCL="" S ACRMCODE=4 D EN2^ACRFDEL Q
S ACRUSER=$P($G(^ACRDOC(ACRDOCDA,"TRNG")),U,26) ;ACR*2.1*3.43
I ACRUSER="" D ;ACR*2.1*3.43
.W !!,"Initiating Supervisor name is missing from the document, cannot proceed" ;ACR*2.1*3.43
.W ! D PAUSE^ACRFWARN ;ACR*2.1*3.43
.S ACRQUIT="" ;ACR;2.1*3.43
Q:$D(ACRQUIT) ;ACR*2.1*3.43
S ACRDOC=$P(ACRDOC0,U),ACRREQST=""
I '$D(^ACRTVAL("B",ACRDOCDA)) D
.D NOW^%DTC
.S ACRNOW=%
.S DIC="^ACRTVAL("
.S (X,DINUM)=ACRDOCDA
.S DIC(0)="L"
.S DIC("DR")=".02////"_DUZ_";.03////"_ACRNOW
.D FILE^ACRFDIC
I '$P(^ACRTVAL(ACRDOCDA,0),U,3) D
.D NOW^%DTC
.S ACRNOW=%
.S DA=ACRDOCDA
.S DIE="^ACRTVAL("
.S DR=".03////"_ACRNOW
.D DIE^ACRFDIC
D SCREEN^ACRFAU
D TVDISP:'$D(ACRSCREN)
Q:$D(ACRQUIT)
I $P(^ACRTVAL(ACRDOCDA,0),U,4) D Q
.W !!,"This evaluation has already been completed and signed."
.W !
.D PAUSE^ACRFWARN
S DA=ACRDOCDA
S DIE="^ACRTVAL("
S DR="[ACR TRAINING EVALUATION]"
D DDS^ACRFDIC
D:$D(ACRSCREN) DIE^ACRFDIC
K ACRSCREN
F ACRI=1:1:12 S:$P($G(^ACRTVAL(ACRDOCDA,"DT")),U,ACRI)="" ACRQUIT=""
I $D(ACRQUIT) D Q
.W !!,"Training Evaluation cannot be signed until Items 1 through 12 are completed."
.W !
.D PAUSE^ACRFWARN
D ^ACRFESIG
;WHEN TRAINING EVALUATION COMPLETE SEND FOR PAYMENT AUTHORIZATION
Q:$D(ACRQUIT)
I +$G(^ACRDOC(ACRDOCDA,"DT")),'$P(^ACRDOC(ACRDOCDA,"DT"),U,2) D ^ACRFRESP Q
D NOW^%DTC
S ACRNOW=%
S DA=ACRDOCDA
S DIE="^ACRTVAL("
S DR=".04////"_ACRNOW
D DIE^ACRFDIC
K ^ACRAPVS("AORDR",ACRDOCDA)
S ACRFINAL="Y"
S ACRAPVT=9
S ACRORDER=1
S ACRLBDA=$P(^ACRDOC(ACRDOCDA,0),U,6)
S ACRREFDA=53
S ACRUSER=$P($G(^ACRDOC(ACRDOCDA,"TRNG")),U,26)
S ACRDATE=ACRNOW
D SETAPP^ACRFAPVS
S ^ACRAPVS("ANXT",9,ACRUSER,+Y)=ACRDOCDA
Q
TVDISP ;EP;TO DISPLAY A TRAINING EVALUATON
N DXS,DIP
S D0=ACRDOCDA
D ^ACRPTE
Q
TO ;EP;
K ACRTVI
S ACRREFX=130
D EN
Q
TR ;EP;
K ACRTVI
S ACRREFX=148
D EN
Q
TV ;EP;
S ACRREFX=600
D EN
Q
TI ;EP;
S ACRREFX=130,ACRTVI=""
D EN
K ACRTVI
Q
YOURTV ;EP;
S ACRREFX=600,ACRURTV=""
D EN
K ACRURTV
Q
TESIGS ;EP;TO DISPLAY TRAINING EVALUATION SIGNATURES
N X,ACRNOI,ACRSIG
W !!,"SIGNATURES FOR TRAINING EVALUATION"
W !,"----------------------------------"
W !,"ATTENDEE.............: "
S X=$G(^ACRTVAL(ACRDOCDA,0))
I '$P(X,U,2) S $P(X,U,2)=$P($G(^ACRDOC(ACRDOCDA,"TRNG")),U,2)
;W:$P(X,U,2) $P($G(^VA(200,$P(X,U,2),0)),U) ;ACR*2.1*19.02 IM16848
W:$P(X,U,2) $$NAME2^ACRFUTL1($P(X,U,2)) ;ACR*2.1*19.02 IM16848
S Y=$P(X,U,4)
X:Y ^DD("DD")
W ?49,$S($P(X,U,4):"COMPLETED ",1:"PENDING")
W ?60,Y
W !,"INITIATION SUPERVISOR: "
N J,X,Y
S (X,J)=0
F S X=$O(^ACRAPVS("AB",ACRDOCDA,X)) Q:'X I $P($G(^ACRAPVS(X,0)),U,3)=9 S J=J+1 I J>1 S X=^ACRAPVS(X,"DT") Q
I '$P(X,U,2) S $P(X,U,2)=$P($G(^ACRDOC(ACRDOCDA,"TRNG")),U,26)
S ACRSIG=$P(X,U,6)
S ACRNOI=$P(X,U,2)
;W $S(ACRSIG:$P($G(^VA(200,ACRSIG,0)),U),1:$P($G(^VA(200,ACRNOI,0)),U)) ;ACR*2.1*19.02 IM16848
W $S(ACRSIG:$$NAME2^ACRFUTL1(ACRSIG),1:$$NAME2^ACRFUTL1(ACRNOI)) ;ACR*2.1*19.02 IM16848
I '$P(X,U,4) W ?49,"PENDING" Q
S Y=$P(X,U,4)
X ^DD("DD")
W ?49,$S($E(X)="A":"APPROVED",$E(X)="C":"CANCELLED",$E(X)="D":"DISAPPROVED",1:"PENDING")
W ?60,Y
I ACRSIG,ACRSIG'=ACRNOI D
. ;W !?21,"(ACRING FOR: "_$P($G(^VA(200,ACRNOI,0)),U)_")" ;ACR*2.1*19.02 IM16848
. W !?21,"(ACRING FOR: "_$$NAME2^ACRFUTL1(ACRNOI)_")" ;ACR*2.1*19.02 IM16848
Q
TREPORT ;EP;TO EDIT TRIP REPORT
W @IOF
W !?20,"Enter your trip report below."
W !!
S DA=ACRDOCDA
S DIE="^ACROBL("
S DR=201
D DIE^ACRFDIC
Q
PTR ;EP;TO PRINT THE TRIP
Q:'$D(ACRPTR)!'$D(^ACROBL(ACRDOCDA,2))
N DXS,DIP
S D0=ACRDOCDA
D ^ACRPTR
D PAUSE^ACRFWARN ;ACR*2.1*3.22
K ACRPTR
Q
ACS ;EP;TO SIGN AGREEMENT TO CONTINUE SERVICE
I $P($G(^ACRDOC(ACRDOCDA,"TRNG")),U,2)'=DUZ S ACRDUZ=$P(^("TRNG"),U,2) D Q
.W !!,"The ",@ACRON,"Agreement to Continue in Service",@ACROF," must be signed by the attendee:"
.N X
.;S X=$P($G(^VA(200,+ACRDUZ,0)),U) ;ACR*2.1*1.902 IM16848
.S X=$$NAME2^ACRFUTL1(+ACRDUZ) ;ACR*2.1*19.02 IM16848
.W !?4,@ACRON,$P($P(X,",",2)," ")," ",$P(X,","),@ACROF
.D PAUSE^ACRFWARN
N X
S X=$P(^ACRDOC(ACRDOCDA,"TRNG"),U,9)+$P(^("TRNG"),U,10)
Q:X<80
W !!,"You received ",X," hours of training."
W !,"Your signature below acknowledges acceptance of"
W !,"The Agreement to Continue in Service."
W !!,"If you have any questions about this agreement and its"
W !,"requirements, please contact your training officer before"
W !,"you enter your electronic signature."
D ^ACRFESIG
Q:$D(ACRQUIT)
I '$D(^ACRTVAL("B",ACRDOCDA)) D
.S DIC="^ACRTVAL("
.S (X,DINUM)=ACRDOCDA
.S DIC(0)="L"
.S DIC("DR")=".02////"_DUZ
.D FILE^ACRFDIC
D NOW^%DTC
S ACRNOW=%
S DA=ACRDOCDA
S DIE="^ACRTVAL("
S DR=".05////"_ACRNOW
D DIE^ACRFDIC
Q
ACSREQ(X) ;EP;TO DETERMINE IF AGREEMENT TO CONTINUE IN SERVICE IS REQUIRED
;AND IF SO WHETHER IT HAS BEEN SIGNED
;X = IEN OF THE TRAINING DOCUMENT
S Y=0
I $P($G(^ACRDOC(+X,"TRNG")),U,9)+$P($G(^("TRNG")),U,10)>79 S Y=1
I $P($G(^ACRTVAL(+X,0)),U,5) S Y=2
Q Y
SELDOC ;EP;TO SELECT TRAVEL DOCUMENT
W @IOF
W !?21,"Select ",$S(ACRREFX'=148:"TRAVEL "_$S(ACRREFX=130:"ORDER",1:"VOUCHER"),1:"TRAINING REPORT")
S DIC="^ACRDOC("
S DIC(0)="AEMQZ"
S DIC("A")=$S(ACRREFX'=148:"Travel Order NO.: ",1:"Training Request NO.: "),ZTRTN="^ACRFQ"
S D="B^G^Q^R"
I '$D(DIC("S")) D
.S DIC("S")=$S(ACRREFX=130:"S ACRREF=$P(^ACRDOC(+Y,0),U,13),ACRREF=$P(^AUTTDOCR(ACRREF,0),U) I ACRREF=130!(ACRREF=600)",ACRREFX=600:"I $P(^ACRDOC(+Y,0),U,13)=$O(^AUTTDOCR(""B"",600,0))",1:"I $P(^ACRDOC(+Y,0),U,13)=$O(^AUTTDOCR(""B"",148,0))")
S:$D(ACRURTV) DIC("S")=DIC("S")_" I $P($G(^ACRDOC(+Y,""TO"")),U,9)=DUZ"
S DIC("S")=DIC("S")_" I $$SCR^ACRFTO(+Y,DUZ)"
W !!
D MIX^ACRFDIC
I +Y<1!$D(ACRQUIT)!$D(ACROUT) S ACRQUIT="" Q
S ACRDOCDA=+Y
S ACRCOMP=""
S ACRREF=ACRREFX
D SETDOC^ACRFEA1
S ACRDOC=$P(ACRDOC0,U),ACRREQST=""
Q
SCR(Y,DUZ) ;EP ;EXTRINSIC FUNCTION
;----- SCREENS FOR ACCESS TO DEPARTMENT ACCOUNT OR DOCUMENT SIGNER
; TO PREVENT UNAUTHORIZED PERSONS FROM VIEWING OR PRINTING
; TRAVEL DOCUMENTS
;
; INPUT:
; Y = DOCUMENT IEN
; DUZ = USER IEN
;
; OUTPUT:
; RETURNS 1 IF DUZ DOES HAVE DEPT ACCOUNT ACCESS OR IS A SIGNER
; OR IS THE TRAVELER OR IS THE TRAVEL REQUESTED BY
; OR IS A HOLDER OF SECURITY KEY ACRFZ TRAVEL ORDERS
; 0 IF DUZ HAS NONE OF THE ABOVE
;
I $D(^ACRLOCB($P(^ACRDOC(Y,0),U,6),"SC","B",DUZ)) Q 1
I $D(^ACRAPVS("AC",Y,DUZ)) Q 1
I $P($G(^ACRDOC(Y,"TO")),U,9)=DUZ Q 1
I $P($G(^ACRDOC(Y,"TO")),U,18)=DUZ Q 1
I $D(^XUSEC("ACRFZ TRAVEL ORDERS",DUZ)) Q 1
Q 0
YOURTA ;EP -- YOUR TRAVEL ADVANCE
;
; FOR FUTURE RELEASE
Q
YOURTO ;EP -- YOUR TRAVEL ORDER
;
; FOR FUTURE RELEASE
Q
ACRFTO ;IHS/OIRM/DSD/THL,AEF - TRAVEL ORDER PROCESSING; [ 09/26/2005 11:20 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,19**;NOV 05, 2001
+2 ;;ROUTINE USED TO PROCESS TRAVEL ORDERS
EN KILL ACRQUIT,ACRUCHK,ACRTXDA
+1 FOR
DO EN1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
EXIT KILL ACRX,ACRDOC,ACRREF,ACRTXTYP,ACRDOC1,ACRMAX,ACRAPVT,ACRQUIT,ACRDA,ACRDOCDA,ACRENTRY,ACRGREF,ACRDOCDA,ACRREF1,ACRY,ACRAPDA,ACRLBDA,ACRNOW,ACRNUM,ACRORD,ACRREFDA,ACRSIG,ACRSIGG,ACRPRT,ACRCOMP,ACRURTV,ACRTPALL,ACRTPAR
+1 KILL ACRSIGP,ACRSIGZ,ACRSIGZZ,ACRFDNO(1),ACRPOA,ACRPO,ACRPPO,ACRPA,ACRXMY
+2 QUIT
EN1 ;EP;
+1 KILL ACRDOCDA,DIC
+2 DO SELDOC
+3 IF '$GET(ACRDOCDA)
SET ACRQUIT=""
QUIT
+4 IF $DATA(ACRTPAR)
QUIT
+5 IF ACRREFX=130
Begin DoDot:1
+6 SET DIR(0)="YO"
+7 SET DIR("A")="Include Travel Expense Summary"
+8 SET DIR("B")="NO"
+9 WRITE !
+10 DO DIR^ACRFDIC
+11 IF +Y'=1
SET ACRDAILY=""
End DoDot:1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+12 ;ACR*2.1*3.23
IF ACRREFX=148
IF (ACRID'["CANCELLED")
Begin DoDot:1
+13 SET DIR(0)="YO"
+14 SET DIR("A")="Include Training Evaluation"
+15 SET DIR("B")="NO"
+16 WRITE !
+17 DO DIR^ACRFDIC
+18 IF $DATA(ACROUT)
QUIT
+19 IF +Y=1
SET ACRTVAL=""
+20 IF $DATA(^ACRTPAR("C",ACRDOCDA))
Begin DoDot:2
+21 KILL ACRTPALL
+22 SET DIR(0)="YO"
+23 SET DIR("A")="Print PERSONNEL FILE Copy of the 350 for each Participant"
+24 SET DIR("B")="NO"
+25 WRITE !
+26 DO DIR^ACRFDIC
+27 IF +Y=1
SET ACRTPALL=""
End DoDot:2
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
End DoDot:1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+28 IF ACRREFX'=148
Begin DoDot:1
+29 SET DIR(0)="YO"
+30 SET DIR("A")="Include Travel Itinerary"
+31 SET DIR("B")="NO"
+32 WRITE !
+33 DO DIR^ACRFDIC
+34 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+35 IF +Y'=1
SET ACRITINY=""
End DoDot:1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+36 IF ACRREFX=600
IF $DATA(^ACROBL(ACRDOCDA,2))
Begin DoDot:1
+37 SET DIR(0)="YO"
+38 SET DIR("A")="Include Trip Report"
+39 SET DIR("B")="NO"
+40 WRITE !
+41 DO DIR^ACRFDIC
+42 IF +Y=1
SET ACRPTR=""
End DoDot:1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+43 IF $DATA(ACRTPALL)
DO ^ACRFTPA1
DO EXIT
QUIT
+44 DO REQ^ACRFQ
+45 ;ACR*2.1*3.22
IF $DATA(ACRPTR)
DO PTR
+46 KILL ACRQUIT,ACRREQST,ACRDAILY,ACRITINY,ACRTVAL
+47 QUIT
TRAIN ;EP;TO SELECT THE TRAINING DOCUMENT AND COMPLETE THE TRAINING
+1 ;;EVALUATION
+2 KILL ACRQUIT
+3 FOR
DO TR1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+4 KILL ACRQUIT
+5 QUIT
TR1 WRITE @IOF
+1 WRITE !?20,"SELECT THE TRAINING DOCUMENT"
+2 SET DIC="^ACRDOC("
+3 SET DIC(0)="AEMQZ"
+4 SET DIC("A")="Select TRAINING DOCUMENT (350): "
+5 SET DIC("S")="I $P($G(^ACRDOC(+Y,""TRNG"")),U,2)=DUZ"
+6 SET DIC("S")=DIC("S")_" I $P($G(^ACROBL(+Y,""APV"")),U)=""A"""
+7 SET D="B^G^R"
+8 WRITE !!
+9 DO MIX^ACRFDIC
+10 IF +Y<1!$DATA(ACRQUIT)!$DATA(ACROUT)
SET ACRQUIT=""
QUIT
+11 SET ACRDOCDA=+Y
+12 SET ACRCOMP=""
+13 SET ACRREF=148
TR2 ;EP;TO COMPLETE TRAINING EVALUATION
+1 ;ACR*2.1*3.16
SET DIR(0)="SO^1:Complete Training Evaluation;2:Cancel Training Order"
+2 SET DIR("A")="Which Action"
+3 WRITE !
+4 DO DIR^ACRFDIC
+5 IF Y<1
QUIT
+6 DO SETDOC^ACRFEA1
+7 IF Y=2
SET ACRCANCL=""
SET ACRMCODE=4
DO EN2^ACRFDEL
QUIT
+8 ;ACR*2.1*3.43
SET ACRUSER=$PIECE($GET(^ACRDOC(ACRDOCDA,"TRNG")),U,26)
+9 ;ACR*2.1*3.43
IF ACRUSER=""
Begin DoDot:1
+10 ;ACR*2.1*3.43
WRITE !!,"Initiating Supervisor name is missing from the document, cannot proceed"
+11 ;ACR*2.1*3.43
WRITE !
DO PAUSE^ACRFWARN
+12 ;ACR;2.1*3.43
SET ACRQUIT=""
End DoDot:1
+13 ;ACR*2.1*3.43
IF $DATA(ACRQUIT)
QUIT
+14 SET ACRDOC=$PIECE(ACRDOC0,U)
SET ACRREQST=""
+15 IF '$DATA(^ACRTVAL("B",ACRDOCDA))
Begin DoDot:1
+16 DO NOW^%DTC
+17 SET ACRNOW=%
+18 SET DIC="^ACRTVAL("
+19 SET (X,DINUM)=ACRDOCDA
+20 SET DIC(0)="L"
+21 SET DIC("DR")=".02////"_DUZ_";.03////"_ACRNOW
+22 DO FILE^ACRFDIC
End DoDot:1
+23 IF '$PIECE(^ACRTVAL(ACRDOCDA,0),U,3)
Begin DoDot:1
+24 DO NOW^%DTC
+25 SET ACRNOW=%
+26 SET DA=ACRDOCDA
+27 SET DIE="^ACRTVAL("
+28 SET DR=".03////"_ACRNOW
+29 DO DIE^ACRFDIC
End DoDot:1
+30 DO SCREEN^ACRFAU
+31 IF '$DATA(ACRSCREN)
DO TVDISP
+32 IF $DATA(ACRQUIT)
QUIT
+33 IF $PIECE(^ACRTVAL(ACRDOCDA,0),U,4)
Begin DoDot:1
+34 WRITE !!,"This evaluation has already been completed and signed."
+35 WRITE !
+36 DO PAUSE^ACRFWARN
End DoDot:1
QUIT
+37 SET DA=ACRDOCDA
+38 SET DIE="^ACRTVAL("
+39 SET DR="[ACR TRAINING EVALUATION]"
+40 DO DDS^ACRFDIC
+41 IF $DATA(ACRSCREN)
DO DIE^ACRFDIC
+42 KILL ACRSCREN
+43 FOR ACRI=1:1:12
IF $PIECE($GET(^ACRTVAL(ACRDOCDA,"DT")),U,ACRI)=""
SET ACRQUIT=""
+44 IF $DATA(ACRQUIT)
Begin DoDot:1
+45 WRITE !!,"Training Evaluation cannot be signed until Items 1 through 12 are completed."
+46 WRITE !
+47 DO PAUSE^ACRFWARN
End DoDot:1
QUIT
+48 DO ^ACRFESIG
+49 ;WHEN TRAINING EVALUATION COMPLETE SEND FOR PAYMENT AUTHORIZATION
+50 IF $DATA(ACRQUIT)
QUIT
+51 IF +$GET(^ACRDOC(ACRDOCDA,"DT"))
IF '$PIECE(^ACRDOC(ACRDOCDA,"DT"),U,2)
DO ^ACRFRESP
QUIT
+52 DO NOW^%DTC
+53 SET ACRNOW=%
+54 SET DA=ACRDOCDA
+55 SET DIE="^ACRTVAL("
+56 SET DR=".04////"_ACRNOW
+57 DO DIE^ACRFDIC
+58 KILL ^ACRAPVS("AORDR",ACRDOCDA)
+59 SET ACRFINAL="Y"
+60 SET ACRAPVT=9
+61 SET ACRORDER=1
+62 SET ACRLBDA=$PIECE(^ACRDOC(ACRDOCDA,0),U,6)
+63 SET ACRREFDA=53
+64 SET ACRUSER=$PIECE($GET(^ACRDOC(ACRDOCDA,"TRNG")),U,26)
+65 SET ACRDATE=ACRNOW
+66 DO SETAPP^ACRFAPVS
+67 SET ^ACRAPVS("ANXT",9,ACRUSER,+Y)=ACRDOCDA
+68 QUIT
TVDISP ;EP;TO DISPLAY A TRAINING EVALUATON
+1 NEW DXS,DIP
+2 SET D0=ACRDOCDA
+3 DO ^ACRPTE
+4 QUIT
TO ;EP;
+1 KILL ACRTVI
+2 SET ACRREFX=130
+3 DO EN
+4 QUIT
TR ;EP;
+1 KILL ACRTVI
+2 SET ACRREFX=148
+3 DO EN
+4 QUIT
TV ;EP;
+1 SET ACRREFX=600
+2 DO EN
+3 QUIT
TI ;EP;
+1 SET ACRREFX=130
SET ACRTVI=""
+2 DO EN
+3 KILL ACRTVI
+4 QUIT
YOURTV ;EP;
+1 SET ACRREFX=600
SET ACRURTV=""
+2 DO EN
+3 KILL ACRURTV
+4 QUIT
TESIGS ;EP;TO DISPLAY TRAINING EVALUATION SIGNATURES
+1 NEW X,ACRNOI,ACRSIG
+2 WRITE !!,"SIGNATURES FOR TRAINING EVALUATION"
+3 WRITE !,"----------------------------------"
+4 WRITE !,"ATTENDEE.............: "
+5 SET X=$GET(^ACRTVAL(ACRDOCDA,0))
+6 IF '$PIECE(X,U,2)
SET $PIECE(X,U,2)=$PIECE($GET(^ACRDOC(ACRDOCDA,"TRNG")),U,2)
+7 ;W:$P(X,U,2) $P($G(^VA(200,$P(X,U,2),0)),U) ;ACR*2.1*19.02 IM16848
+8 ;ACR*2.1*19.02 IM16848
IF $PIECE(X,U,2)
WRITE $$NAME2^ACRFUTL1($PIECE(X,U,2))
+9 SET Y=$PIECE(X,U,4)
+10 IF Y
XECUTE ^DD("DD")
+11 WRITE ?49,$SELECT($PIECE(X,U,4):"COMPLETED ",1:"PENDING")
+12 WRITE ?60,Y
+13 WRITE !,"INITIATION SUPERVISOR: "
+14 NEW J,X,Y
+15 SET (X,J)=0
+16 FOR
SET X=$ORDER(^ACRAPVS("AB",ACRDOCDA,X))
IF 'X
QUIT
IF $PIECE($GET(^ACRAPVS(X,0)),U,3)=9
SET J=J+1
IF J>1
SET X=^ACRAPVS(X,"DT")
QUIT
+17 IF '$PIECE(X,U,2)
SET $PIECE(X,U,2)=$PIECE($GET(^ACRDOC(ACRDOCDA,"TRNG")),U,26)
+18 SET ACRSIG=$PIECE(X,U,6)
+19 SET ACRNOI=$PIECE(X,U,2)
+20 ;W $S(ACRSIG:$P($G(^VA(200,ACRSIG,0)),U),1:$P($G(^VA(200,ACRNOI,0)),U)) ;ACR*2.1*19.02 IM16848
+21 ;ACR*2.1*19.02 IM16848
WRITE $SELECT(ACRSIG:$$NAME2^ACRFUTL1(ACRSIG),1:$$NAME2^ACRFUTL1(ACRNOI))
+22 IF '$PIECE(X,U,4)
WRITE ?49,"PENDING"
QUIT
+23 SET Y=$PIECE(X,U,4)
+24 XECUTE ^DD("DD")
+25 WRITE ?49,$SELECT($EXTRACT(X)="A":"APPROVED",$EXTRACT(X)="C":"CANCELLED",$EXTRACT(X)="D":"DISAPPROVED",1:"PENDING")
+26 WRITE ?60,Y
+27 IF ACRSIG
IF ACRSIG'=ACRNOI
Begin DoDot:1
+28 ;W !?21,"(ACRING FOR: "_$P($G(^VA(200,ACRNOI,0)),U)_")" ;ACR*2.1*19.02 IM16848
+29 ;ACR*2.1*19.02 IM16848
WRITE !?21,"(ACRING FOR: "_$$NAME2^ACRFUTL1(ACRNOI)_")"
End DoDot:1
+30 QUIT
TREPORT ;EP;TO EDIT TRIP REPORT
+1 WRITE @IOF
+2 WRITE !?20,"Enter your trip report below."
+3 WRITE !!
+4 SET DA=ACRDOCDA
+5 SET DIE="^ACROBL("
+6 SET DR=201
+7 DO DIE^ACRFDIC
+8 QUIT
PTR ;EP;TO PRINT THE TRIP
+1 IF '$DATA(ACRPTR)!'$DATA(^ACROBL(ACRDOCDA,2))
QUIT
+2 NEW DXS,DIP
+3 SET D0=ACRDOCDA
+4 DO ^ACRPTR
+5 ;ACR*2.1*3.22
DO PAUSE^ACRFWARN
+6 KILL ACRPTR
+7 QUIT
ACS ;EP;TO SIGN AGREEMENT TO CONTINUE SERVICE
+1 IF $PIECE($GET(^ACRDOC(ACRDOCDA,"TRNG")),U,2)'=DUZ
SET ACRDUZ=$PIECE(^("TRNG"),U,2)
Begin DoDot:1
+2 WRITE !!,"The ",@ACRON,"Agreement to Continue in Service",@ACROF," must be signed by the attendee:"
+3 NEW X
+4 ;S X=$P($G(^VA(200,+ACRDUZ,0)),U) ;ACR*2.1*1.902 IM16848
+5 ;ACR*2.1*19.02 IM16848
SET X=$$NAME2^ACRFUTL1(+ACRDUZ)
+6 WRITE !?4,@ACRON,$PIECE($PIECE(X,",",2)," ")," ",$PIECE(X,","),@ACROF
+7 DO PAUSE^ACRFWARN
End DoDot:1
QUIT
+8 NEW X
+9 SET X=$PIECE(^ACRDOC(ACRDOCDA,"TRNG"),U,9)+$PIECE(^("TRNG"),U,10)
+10 IF X<80
QUIT
+11 WRITE !!,"You received ",X," hours of training."
+12 WRITE !,"Your signature below acknowledges acceptance of"
+13 WRITE !,"The Agreement to Continue in Service."
+14 WRITE !!,"If you have any questions about this agreement and its"
+15 WRITE !,"requirements, please contact your training officer before"
+16 WRITE !,"you enter your electronic signature."
+17 DO ^ACRFESIG
+18 IF $DATA(ACRQUIT)
QUIT
+19 IF '$DATA(^ACRTVAL("B",ACRDOCDA))
Begin DoDot:1
+20 SET DIC="^ACRTVAL("
+21 SET (X,DINUM)=ACRDOCDA
+22 SET DIC(0)="L"
+23 SET DIC("DR")=".02////"_DUZ
+24 DO FILE^ACRFDIC
End DoDot:1
+25 DO NOW^%DTC
+26 SET ACRNOW=%
+27 SET DA=ACRDOCDA
+28 SET DIE="^ACRTVAL("
+29 SET DR=".05////"_ACRNOW
+30 DO DIE^ACRFDIC
+31 QUIT
ACSREQ(X) ;EP;TO DETERMINE IF AGREEMENT TO CONTINUE IN SERVICE IS REQUIRED
+1 ;AND IF SO WHETHER IT HAS BEEN SIGNED
+2 ;X = IEN OF THE TRAINING DOCUMENT
+3 SET Y=0
+4 IF $PIECE($GET(^ACRDOC(+X,"TRNG")),U,9)+$PIECE($GET(^("TRNG")),U,10)>79
SET Y=1
+5 IF $PIECE($GET(^ACRTVAL(+X,0)),U,5)
SET Y=2
+6 QUIT Y
SELDOC ;EP;TO SELECT TRAVEL DOCUMENT
+1 WRITE @IOF
+2 WRITE !?21,"Select ",$SELECT(ACRREFX'=148:"TRAVEL "_$SELECT(ACRREFX=130:"ORDER",1:"VOUCHER"),1:"TRAINING REPORT")
+3 SET DIC="^ACRDOC("
+4 SET DIC(0)="AEMQZ"
+5 SET DIC("A")=$SELECT(ACRREFX'=148:"Travel Order NO.: ",1:"Training Request NO.: ")
SET ZTRTN="^ACRFQ"
+6 SET D="B^G^Q^R"
+7 IF '$DATA(DIC("S"))
Begin DoDot:1
+8 SET DIC("S")=$SELECT(ACRREFX=130:"S ACRREF=$P(^ACRDOC(+Y,0),U,13),ACRREF=$P(^AUTTDOCR(ACRREF,0),U) I ACRREF=130!(ACRREF=600)",ACRREFX=600:"I $P(^ACRDOC(+Y,0),U,13)=$O(^AUTTDOCR(""B"",600,0))",1:"I $P(^ACRDOC(+Y,0),U,13)=$O(^AUTTDOCR(""B
"",148,0))")
End DoDot:1
+9 IF $DATA(ACRURTV)
SET DIC("S")=DIC("S")_" I $P($G(^ACRDOC(+Y,""TO"")),U,9)=DUZ"
+10 SET DIC("S")=DIC("S")_" I $$SCR^ACRFTO(+Y,DUZ)"
+11 WRITE !!
+12 DO MIX^ACRFDIC
+13 IF +Y<1!$DATA(ACRQUIT)!$DATA(ACROUT)
SET ACRQUIT=""
QUIT
+14 SET ACRDOCDA=+Y
+15 SET ACRCOMP=""
+16 SET ACRREF=ACRREFX
+17 DO SETDOC^ACRFEA1
+18 SET ACRDOC=$PIECE(ACRDOC0,U)
SET ACRREQST=""
+19 QUIT
SCR(Y,DUZ) ;EP ;EXTRINSIC FUNCTION
+1 ;----- SCREENS FOR ACCESS TO DEPARTMENT ACCOUNT OR DOCUMENT SIGNER
+2 ; TO PREVENT UNAUTHORIZED PERSONS FROM VIEWING OR PRINTING
+3 ; TRAVEL DOCUMENTS
+4 ;
+5 ; INPUT:
+6 ; Y = DOCUMENT IEN
+7 ; DUZ = USER IEN
+8 ;
+9 ; OUTPUT:
+10 ; RETURNS 1 IF DUZ DOES HAVE DEPT ACCOUNT ACCESS OR IS A SIGNER
+11 ; OR IS THE TRAVELER OR IS THE TRAVEL REQUESTED BY
+12 ; OR IS A HOLDER OF SECURITY KEY ACRFZ TRAVEL ORDERS
+13 ; 0 IF DUZ HAS NONE OF THE ABOVE
+14 ;
+15 IF $DATA(^ACRLOCB($PIECE(^ACRDOC(Y,0),U,6),"SC","B",DUZ))
QUIT 1
+16 IF $DATA(^ACRAPVS("AC",Y,DUZ))
QUIT 1
+17 IF $PIECE($GET(^ACRDOC(Y,"TO")),U,9)=DUZ
QUIT 1
+18 IF $PIECE($GET(^ACRDOC(Y,"TO")),U,18)=DUZ
QUIT 1
+19 IF $DATA(^XUSEC("ACRFZ TRAVEL ORDERS",DUZ))
QUIT 1
+20 QUIT 0
YOURTA ;EP -- YOUR TRAVEL ADVANCE
+1 ;
+2 ; FOR FUTURE RELEASE
+3 QUIT
YOURTO ;EP -- YOUR TRAVEL ORDER
+1 ;
+2 ; FOR FUTURE RELEASE
+3 QUIT
