Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACRFTO

ACRFTO.m

Go to the documentation of this file. 
  1. 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
  1.  ;;ROUTINE USED TO PROCESS TRAVEL ORDERS
  1. EN K ACRQUIT,ACRUCHK,ACRTXDA
  1.  F  D EN1 Q:$D(ACRQUIT)!$D(ACROUT)
  1. 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
  1.  K ACRSIGP,ACRSIGZ,ACRSIGZZ,ACRFDNO(1),ACRPOA,ACRPO,ACRPPO,ACRPA,ACRXMY
  1.  Q
  1. EN1 ;EP;
  1.  K ACRDOCDA,DIC
  1.  D SELDOC
  1.  I '$G(ACRDOCDA) S ACRQUIT="" Q
  1.  Q:$D(ACRTPAR)
  1.  I ACRREFX=130 D  Q:$D(ACRQUIT)!$D(ACROUT)
  1.  .S DIR(0)="YO"
  1.  .S DIR("A")="Include Travel Expense Summary"
  1.  .S DIR("B")="NO"
  1.  .W !
  1.  .D DIR^ACRFDIC
  1.  .I +Y'=1 S ACRDAILY=""
  1.  I ACRREFX=148,(ACRID'["CANCELLED") D  Q:$D(ACRQUIT)!$D(ACROUT)   ;ACR*2.1*3.23
  1.  .S DIR(0)="YO"
  1.  .S DIR("A")="Include Training Evaluation"
  1.  .S DIR("B")="NO"
  1.  .W !
  1.  .D DIR^ACRFDIC
  1.  .Q:$D(ACROUT)
  1.  .I +Y=1 S ACRTVAL=""
  1.  .I $D(^ACRTPAR("C",ACRDOCDA)) D  Q:$D(ACRQUIT)!$D(ACROUT)
  1.  ..K ACRTPALL
  1.  ..S DIR(0)="YO"
  1.  ..S DIR("A")="Print PERSONNEL FILE Copy of the 350 for each Participant"
  1.  ..S DIR("B")="NO"
  1.  ..W !
  1.  ..D DIR^ACRFDIC
  1.  ..I +Y=1 S ACRTPALL=""
  1.  I ACRREFX'=148 D  Q:$D(ACRQUIT)!$D(ACROUT)
  1.  .S DIR(0)="YO"
  1.  .S DIR("A")="Include Travel Itinerary"
  1.  .S DIR("B")="NO"
  1.  .W !
  1.  .D DIR^ACRFDIC
  1.  .Q:$D(ACRQUIT)!$D(ACROUT)
  1.  .I +Y'=1 S ACRITINY=""
  1.  I ACRREFX=600,$D(^ACROBL(ACRDOCDA,2)) D  Q:$D(ACRQUIT)!$D(ACROUT)
  1.  .S DIR(0)="YO"
  1.  .S DIR("A")="Include Trip Report"
  1.  .S DIR("B")="NO"
  1.  .W !
  1.  .D DIR^ACRFDIC
  1.  .I +Y=1 S ACRPTR=""
  1.  I $D(ACRTPALL) D ^ACRFTPA1,EXIT Q
  1.  D REQ^ACRFQ
  1.  I $D(ACRPTR) D PTR ;ACR*2.1*3.22
  1.  K ACRQUIT,ACRREQST,ACRDAILY,ACRITINY,ACRTVAL
  1.  Q
  1. TRAIN ;EP;TO SELECT THE TRAINING DOCUMENT AND COMPLETE THE TRAINING
  1.  ;;EVALUATION
  1.  K ACRQUIT
  1.  F  D TR1 Q:$D(ACRQUIT)!$D(ACROUT)
  1.  K ACRQUIT
  1.  Q
  1. TR1 W @IOF
  1.  W !?20,"SELECT THE TRAINING DOCUMENT"
  1.  S DIC="^ACRDOC("
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Select TRAINING DOCUMENT (350): "
  1.  S DIC("S")="I $P($G(^ACRDOC(+Y,""TRNG"")),U,2)=DUZ"
  1.  S DIC("S")=DIC("S")_" I $P($G(^ACROBL(+Y,""APV"")),U)=""A"""
  1.  S D="B^G^R"
  1.  W !!
  1.  D MIX^ACRFDIC
  1.  I +Y<1!$D(ACRQUIT)!$D(ACROUT) S ACRQUIT="" Q
  1.  S ACRDOCDA=+Y
  1.  S ACRCOMP=""
  1.  S ACRREF=148
  1. TR2 ;EP;TO COMPLETE TRAINING EVALUATION
  1.  S DIR(0)="SO^1:Complete Training Evaluation;2:Cancel Training Order" ;ACR*2.1*3.16
  1.  S DIR("A")="Which Action"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  Q:Y<1
  1.  D SETDOC^ACRFEA1
  1.  I Y=2 S ACRCANCL="" S ACRMCODE=4 D EN2^ACRFDEL Q
  1.  S ACRUSER=$P($G(^ACRDOC(ACRDOCDA,"TRNG")),U,26) ;ACR*2.1*3.43
  1.  I ACRUSER="" D   ;ACR*2.1*3.43
  1.  .W !!,"Initiating Supervisor name is missing from the document, cannot proceed" ;ACR*2.1*3.43
  1.  .W ! D PAUSE^ACRFWARN ;ACR*2.1*3.43
  1.  .S ACRQUIT="" ;ACR;2.1*3.43
  1.  Q:$D(ACRQUIT)   ;ACR*2.1*3.43
  1.  S ACRDOC=$P(ACRDOC0,U),ACRREQST=""
  1.  I '$D(^ACRTVAL("B",ACRDOCDA)) D
  1.  .D NOW^%DTC
  1.  .S ACRNOW=%
  1.  .S DIC="^ACRTVAL("
  1.  .S (X,DINUM)=ACRDOCDA
  1.  .S DIC(0)="L"
  1.  .S DIC("DR")=".02////"_DUZ_";.03////"_ACRNOW
  1.  .D FILE^ACRFDIC
  1.  I '$P(^ACRTVAL(ACRDOCDA,0),U,3) D
  1.  .D NOW^%DTC
  1.  .S ACRNOW=%
  1.  .S DA=ACRDOCDA
  1.  .S DIE="^ACRTVAL("
  1.  .S DR=".03////"_ACRNOW
  1.  .D DIE^ACRFDIC
  1.  D SCREEN^ACRFAU
  1.  D TVDISP:'$D(ACRSCREN)
  1.  Q:$D(ACRQUIT)
  1.  I $P(^ACRTVAL(ACRDOCDA,0),U,4) D  Q
  1.  .W !!,"This evaluation has already been completed and signed."
  1.  .W !
  1.  .D PAUSE^ACRFWARN
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACRTVAL("
  1.  S DR="[ACR TRAINING EVALUATION]"
  1.  D DDS^ACRFDIC
  1.  D:$D(ACRSCREN) DIE^ACRFDIC
  1.  K ACRSCREN
  1.  F ACRI=1:1:12 S:$P($G(^ACRTVAL(ACRDOCDA,"DT")),U,ACRI)="" ACRQUIT=""
  1.  I $D(ACRQUIT) D  Q
  1.  .W !!,"Training Evaluation cannot be signed until Items 1 through 12 are completed."
  1.  .W !
  1.  .D PAUSE^ACRFWARN
  1.  D ^ACRFESIG
  1.  ;WHEN TRAINING EVALUATION COMPLETE SEND FOR PAYMENT AUTHORIZATION
  1.  Q:$D(ACRQUIT)
  1.  I +$G(^ACRDOC(ACRDOCDA,"DT")),'$P(^ACRDOC(ACRDOCDA,"DT"),U,2) D ^ACRFRESP Q
  1.  D NOW^%DTC
  1.  S ACRNOW=%
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACRTVAL("
  1.  S DR=".04////"_ACRNOW
  1.  D DIE^ACRFDIC
  1.  K ^ACRAPVS("AORDR",ACRDOCDA)
  1.  S ACRFINAL="Y"
  1.  S ACRAPVT=9
  1.  S ACRORDER=1
  1.  S ACRLBDA=$P(^ACRDOC(ACRDOCDA,0),U,6)
  1.  S ACRREFDA=53
  1.  S ACRUSER=$P($G(^ACRDOC(ACRDOCDA,"TRNG")),U,26)
  1.  S ACRDATE=ACRNOW
  1.  D SETAPP^ACRFAPVS
  1.  S ^ACRAPVS("ANXT",9,ACRUSER,+Y)=ACRDOCDA
  1.  Q
  1. TVDISP ;EP;TO DISPLAY A TRAINING EVALUATON
  1.  N DXS,DIP
  1.  S D0=ACRDOCDA
  1.  D ^ACRPTE
  1.  Q
  1. TO ;EP;
  1.  K ACRTVI
  1.  S ACRREFX=130
  1.  D EN
  1.  Q
  1. TR ;EP;
  1.  K ACRTVI
  1.  S ACRREFX=148
  1.  D EN
  1.  Q
  1. TV ;EP;
  1.  S ACRREFX=600
  1.  D EN
  1.  Q
  1. TI ;EP;
  1.  S ACRREFX=130,ACRTVI=""
  1.  D EN
  1.  K ACRTVI
  1.  Q
  1. YOURTV ;EP;
  1.  S ACRREFX=600,ACRURTV=""
  1.  D EN
  1.  K ACRURTV
  1.  Q
  1. TESIGS ;EP;TO DISPLAY TRAINING EVALUATION SIGNATURES
  1.  N X,ACRNOI,ACRSIG
  1.  W !!,"SIGNATURES FOR TRAINING EVALUATION"
  1.  W !,"----------------------------------"
  1.  W !,"ATTENDEE.............: "
  1.  S X=$G(^ACRTVAL(ACRDOCDA,0))
  1.  I '$P(X,U,2) S $P(X,U,2)=$P($G(^ACRDOC(ACRDOCDA,"TRNG")),U,2)
  1.  ;W:$P(X,U,2) $P($G(^VA(200,$P(X,U,2),0)),U)  ;ACR*2.1*19.02 IM16848
  1.  W:$P(X,U,2) $$NAME2^ACRFUTL1($P(X,U,2))  ;ACR*2.1*19.02 IM16848
  1.  S Y=$P(X,U,4)
  1.  X:Y ^DD("DD")
  1.  W ?49,$S($P(X,U,4):"COMPLETED ",1:"PENDING")
  1.  W ?60,Y
  1.  W !,"INITIATION SUPERVISOR: "
  1.  N J,X,Y
  1.  S (X,J)=0
  1.  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
  1.  I '$P(X,U,2) S $P(X,U,2)=$P($G(^ACRDOC(ACRDOCDA,"TRNG")),U,26)
  1.  S ACRSIG=$P(X,U,6)
  1.  S ACRNOI=$P(X,U,2)
  1.  ;W $S(ACRSIG:$P($G(^VA(200,ACRSIG,0)),U),1:$P($G(^VA(200,ACRNOI,0)),U))  ;ACR*2.1*19.02 IM16848
  1.  W $S(ACRSIG:$$NAME2^ACRFUTL1(ACRSIG),1:$$NAME2^ACRFUTL1(ACRNOI))  ;ACR*2.1*19.02 IM16848
  1.  I '$P(X,U,4) W ?49,"PENDING" Q
  1.  S Y=$P(X,U,4)
  1.  X ^DD("DD")
  1.  W ?49,$S($E(X)="A":"APPROVED",$E(X)="C":"CANCELLED",$E(X)="D":"DISAPPROVED",1:"PENDING")
  1.  W ?60,Y
  1.  I ACRSIG,ACRSIG'=ACRNOI D
  1.  . ;W !?21,"(ACRING FOR: "_$P($G(^VA(200,ACRNOI,0)),U)_")"  ;ACR*2.1*19.02 IM16848
  1.  . W !?21,"(ACRING FOR: "_$$NAME2^ACRFUTL1(ACRNOI)_")"  ;ACR*2.1*19.02 IM16848
  1.  Q
  1. TREPORT ;EP;TO EDIT TRIP REPORT
  1.  W @IOF
  1.  W !?20,"Enter your trip report below."
  1.  W !!
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACROBL("
  1.  S DR=201
  1.  D DIE^ACRFDIC
  1.  Q
  1. PTR ;EP;TO PRINT THE TRIP
  1.  Q:'$D(ACRPTR)!'$D(^ACROBL(ACRDOCDA,2))
  1.  N DXS,DIP
  1.  S D0=ACRDOCDA
  1.  D ^ACRPTR
  1.  D PAUSE^ACRFWARN ;ACR*2.1*3.22
  1.  K ACRPTR
  1.  Q
  1. ACS ;EP;TO SIGN AGREEMENT TO CONTINUE SERVICE
  1.  I $P($G(^ACRDOC(ACRDOCDA,"TRNG")),U,2)'=DUZ S ACRDUZ=$P(^("TRNG"),U,2) D  Q
  1.  .W !!,"The ",@ACRON,"Agreement to Continue in Service",@ACROF," must be signed by the attendee:"
  1.  .N X
  1.  .;S X=$P($G(^VA(200,+ACRDUZ,0)),U)  ;ACR*2.1*1.902 IM16848
  1.  .S X=$$NAME2^ACRFUTL1(+ACRDUZ)  ;ACR*2.1*19.02 IM16848
  1.  .W !?4,@ACRON,$P($P(X,",",2)," ")," ",$P(X,","),@ACROF
  1.  .D PAUSE^ACRFWARN
  1.  N X
  1.  S X=$P(^ACRDOC(ACRDOCDA,"TRNG"),U,9)+$P(^("TRNG"),U,10)
  1.  Q:X<80
  1.  W !!,"You received ",X," hours of training."
  1.  W !,"Your signature below acknowledges acceptance of"
  1.  W !,"The Agreement to Continue in Service."
  1.  W !!,"If you have any questions about this agreement and its"
  1.  W !,"requirements, please contact your training officer before"
  1.  W !,"you enter your electronic signature."
  1.  D ^ACRFESIG
  1.  Q:$D(ACRQUIT)
  1.  I '$D(^ACRTVAL("B",ACRDOCDA)) D
  1.  .S DIC="^ACRTVAL("
  1.  .S (X,DINUM)=ACRDOCDA
  1.  .S DIC(0)="L"
  1.  .S DIC("DR")=".02////"_DUZ
  1.  .D FILE^ACRFDIC
  1.  D NOW^%DTC
  1.  S ACRNOW=%
  1.  S DA=ACRDOCDA
  1.  S DIE="^ACRTVAL("
  1.  S DR=".05////"_ACRNOW
  1.  D DIE^ACRFDIC
  1.  Q
  1. ACSREQ(X) ;EP;TO DETERMINE IF AGREEMENT TO CONTINUE IN SERVICE IS REQUIRED
  1.  ;AND IF SO WHETHER IT HAS BEEN SIGNED
  1.  ;X = IEN OF THE TRAINING DOCUMENT
  1.  S Y=0
  1.  I $P($G(^ACRDOC(+X,"TRNG")),U,9)+$P($G(^("TRNG")),U,10)>79 S Y=1
  1.  I $P($G(^ACRTVAL(+X,0)),U,5) S Y=2
  1.  Q Y
  1. SELDOC ;EP;TO SELECT TRAVEL DOCUMENT
  1.  W @IOF
  1.  W !?21,"Select ",$S(ACRREFX'=148:"TRAVEL "_$S(ACRREFX=130:"ORDER",1:"VOUCHER"),1:"TRAINING REPORT")
  1.  S DIC="^ACRDOC("
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")=$S(ACRREFX'=148:"Travel Order NO.: ",1:"Training Request NO.: "),ZTRTN="^ACRFQ"
  1.  S D="B^G^Q^R"
  1.  I '$D(DIC("S")) D
  1.  .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))")
  1.  S:$D(ACRURTV) DIC("S")=DIC("S")_" I $P($G(^ACRDOC(+Y,""TO"")),U,9)=DUZ"
  1.  S DIC("S")=DIC("S")_" I $$SCR^ACRFTO(+Y,DUZ)"
  1.  W !!
  1.  D MIX^ACRFDIC
  1.  I +Y<1!$D(ACRQUIT)!$D(ACROUT) S ACRQUIT="" Q
  1.  S ACRDOCDA=+Y
  1.  S ACRCOMP=""
  1.  S ACRREF=ACRREFX
  1.  D SETDOC^ACRFEA1
  1.  S ACRDOC=$P(ACRDOC0,U),ACRREQST=""
  1.  Q
  1. SCR(Y,DUZ)         ;EP ;EXTRINSIC FUNCTION
  1.  ;----- SCREENS FOR ACCESS TO DEPARTMENT ACCOUNT OR DOCUMENT SIGNER
  1.  ;      TO PREVENT UNAUTHORIZED PERSONS FROM VIEWING OR PRINTING
  1.  ;      TRAVEL DOCUMENTS
  1.  ;
  1.  ;      INPUT:
  1.  ;      Y   = DOCUMENT IEN
  1.  ;      DUZ = USER IEN
  1.  ;
  1.  ;      OUTPUT:
  1.  ;      RETURNS  1 IF DUZ DOES HAVE DEPT ACCOUNT ACCESS OR IS A SIGNER
  1.  ;                 OR IS THE TRAVELER OR IS THE TRAVEL REQUESTED BY
  1.  ;                 OR IS A HOLDER OF SECURITY KEY ACRFZ TRAVEL ORDERS
  1.  ;               0 IF DUZ HAS NONE OF THE ABOVE
  1.  ;
  1.  I $D(^ACRLOCB($P(^ACRDOC(Y,0),U,6),"SC","B",DUZ)) Q 1
  1.  I $D(^ACRAPVS("AC",Y,DUZ)) Q 1
  1.  I $P($G(^ACRDOC(Y,"TO")),U,9)=DUZ Q 1
  1.  I $P($G(^ACRDOC(Y,"TO")),U,18)=DUZ Q 1
  1.  I $D(^XUSEC("ACRFZ TRAVEL ORDERS",DUZ)) Q 1
  1.  Q 0
  1. YOURTA ;EP -- YOUR TRAVEL ADVANCE
  1.  ;
  1.  ;      FOR FUTURE RELEASE
  1.  Q
  1. YOURTO ;EP -- YOUR TRAVEL ORDER
  1.  ;
  1.  ;      FOR FUTURE RELEASE
  1.  Q