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

ACRFFF4.m

Go to the documentation of this file. 
  1. ACRFFF4 ;IHS/OIRM/DSD/AEF - PRODUCE FLAT FILE OF TRAINING INFORMATION [ 09/23/2005   4:18 PM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**13,19**;NOV 05, 2001
  1.  ;
  1. DESC ;----- ROUTINE DESCRIPTION
  1.  ;;Create Training Information Flat File
  1.  ;;
  1.  ;;This option will gather all training documents within the
  1.  ;;specified date range and place them into a UNIX comma
  1.  ;;delimited flat file which can then be imported into an
  1.  ;;Access or Excel spreadsheet.
  1.  ;;
  1.  ;;Fields included in the flat file are:
  1.  ;;      1. ASUFAC Code                    14. Training Hours (Duty)
  1.  ;;      2. CAN Number                     15. Tuition & Fees
  1.  ;;      3. Training Order Number          16. Books & Other
  1.  ;;      4. Attendee Name                  17. Travel Order Number
  1.  ;;      5. Official Duty Station          18. Travel From City
  1.  ;;      6. ODS Area                       19. Travel From State
  1.  ;;      7. Gender                         20. Travel To City
  1.  ;;      8. Pay Plan                       21. Travel To State
  1.  ;;      9. Grade                          22. Transportation Cost
  1.  ;;     10. Series                         23. Per Diem
  1.  ;;     11. Training Begin Date            24. Other Expenses
  1.  ;;     12. Training End Date              25. Travel Mgt. Fee
  1.  ;;     13. Training Course Title          26. Training Order Status
  1.  ;;$$END
  1.  ;
  1. EN ;EP -- MAIN ENTRY POINT
  1.  ;
  1.  N ACRDATES,ACRFILE
  1.  ;
  1.  D ^XBKVAR
  1.  D HOME^%ZIS
  1.  ;
  1.  D TXT
  1.  ;
  1.  D DATES(.ACRDATES)
  1.  Q:$G(ACRDATES)']""
  1.  ;
  1.  D FILE(.ACRFILE)
  1.  Q:$G(ACRFILE)']""
  1.  ;
  1.  W "   please wait..."
  1.  ;
  1.  D GET(ACRDATES)
  1.  ;
  1.  I '$D(^TMP("ACR",$J,"G")) D  Q
  1.  . W !!,"No data found"
  1.  . D PAUSE^ACRFWARN
  1.  ;
  1.  D UNIX(ACRFILE)
  1.  ;
  1.  ;K ^TMP("ACR",$J)
  1.  ;
  1.  D ^%ZISC
  1.  ;
  1.  D PAUSE^ACRFWARN
  1.  ;
  1.  Q
  1. GET(ACRDATES)      ;
  1.  ;----- LOOP THROUGH TRAINING ORDERS AND PUT DATA INTO ^TMP GLOBAL
  1.  ;
  1.  N ACRDATA,ACRDOCDA,ACRDOCNO,ACRREF,ACRTONO
  1.  ;
  1.  K ^TMP("ACR",$J)
  1.  ;
  1.  S ACRREF=$O(^AUTTDOCR("B",148,0))
  1.  S ACRDOCDA=0
  1.  F  S ACRDOCDA=$O(^ACRDOC("REF",ACRREF,ACRDOCDA)) Q:'ACRDOCDA  D
  1.  . S ACRDATA=$G(^ACRDOC(ACRDOCDA,"TRNG"))
  1.  . Q:$P(ACRDATA,U,11)<$P(ACRDATES,U)
  1.  . Q:$P(ACRDATA,U,11)>$P(ACRDATES,U,2)
  1.  . D ONE(ACRDOCDA)
  1.  ;
  1.  Q
  1. ONE(ACRDOCDA)      ;
  1.  ;----- GATHER DATA FOR ONE DOCUMENT AND PUT INTO ^TMP GLOBAL         
  1.  ; 
  1.  ;      ACRATT    =  ATTENDEE IEN
  1.  ;      ACRDOCDA  =  TRAINING DOCUMENT IEN
  1.  ;      ACRDOCNO  =  TRAINING DOCUMENT NUMBER
  1.  ;      ACRTODA   =  TRAVEL DOCUMENT IEN
  1.  ;      ACRTONO   =  TRAVEL DOCUMENT NUMBER
  1.  ;
  1.  N ACRDOCNO,ACRTODA,ACRTONO,Z
  1.  ;
  1.  S ACRDOCNO=$$DOCNO(ACRDOCDA)
  1.  S ACRATT=$P($G(^ACRDOC(ACRDOCDA,"TRNG")),U,2)
  1.  S ACRTODA=$P($G(^ACRDOC(ACRDOCDA,"TRNGTO")),U)
  1.  S ACRTONO=""
  1.  I ACRTODA D
  1.  . S ACRTONO=$P($G(^ACRDOC(ACRTODA,0)),U)
  1.  ;
  1.  ;TUITION & FEES, BOOKS & OTHER, PER DIEM, ETC.
  1.  I ACRDOCDA D AMTS(ACRDOCDA)
  1.  I ACRTODA D AMTS(ACRTODA)
  1.  ;
  1.  ;
  1.  ;----- SET DATA INTO ^TMP GLOBAL
  1.  ;
  1.  S $P(Z,U)=$$ASUFAC($$LOC(ACRATT))
  1.  S $P(Z,U,2)=$$CAN(ACRDOCDA)
  1.  S $P(Z,U,3)=ACRDOCNO
  1.  S $P(Z,U,4)=$$NAME(ACRDOCDA)
  1.  S $P(Z,U,5)=$$ODS(ACRATT)
  1.  S $P(Z,U,6)=$$ODSA(ACRATT)
  1.  S $P(Z,U,7)=$$SEX(ACRATT)
  1.  S $P(Z,U,8)=$$PAYPLAN(ACRATT)
  1.  S $P(Z,U,9)=$$GRADE(ACRATT)
  1.  S $P(Z,U,10)=$$SER(ACRATT)
  1.  S $P(Z,U,11)=$$BEG(ACRDOCDA)
  1.  S $P(Z,U,12)=$$END(ACRDOCDA)
  1.  S $P(Z,U,13)=$$TITLE(ACRDOCDA)
  1.  S $P(Z,U,14)=$$HRS(ACRDOCDA)
  1.  I ACRDOCNO]"" D
  1.  . S $P(Z,U,15)=$G(^TMP("ACR",$J,"AMT",ACRDOCNO,"Tuition & Fees",0))
  1.  . S $P(Z,U,16)=$G(^TMP("ACR",$J,"AMT",ACRDOCNO,"Books & Other",0))
  1.  I ACRTONO]"" D
  1.  . S $P(Z,U,17)=ACRTONO
  1.  . S $P(Z,U,18)=$P($$TVLF(ACRTODA),U)
  1.  . S $P(Z,U,19)=$P($$TVLF(ACRTODA),U,2)
  1.  . S $P(Z,U,20)=$P($$TVLT(ACRTODA),U)
  1.  . S $P(Z,U,21)=$P($$TVLT(ACRTODA),U,2)
  1.  . S $P(Z,U,22)=$G(^TMP("ACR",$J,"AMT",ACRTONO,"Travel-DHHS",0))
  1.  . S $P(Z,U,23)=$G(^TMP("ACR",$J,"AMT",ACRTONO,"Per Diem-DHHS",0))
  1.  . S $P(Z,U,24)=$G(^TMP("ACR",$J,"AMT",ACRTONO,"Other Exp-DHHS",0))
  1.  . S $P(Z,U,25)=$G(^TMP("ACR",$J,"AMT",ACRTONO,"Travel Mgt Fee",0))
  1.  S $P(Z,U,26)=$$STAT(ACRDOCDA)
  1.  ;
  1.  S ^TMP("ACR",$J,"G",$E(ACRDOCNO,1,10),ACRDOCNO,0)=Z
  1.  ;
  1.  I '$D(^TMP("ACR",$J,"G",$E(ACRDOCNO,1,10),0)) D  Q
  1.  . S ^TMP("ACR",$J,"G",$E(ACRDOCNO,1,10),0)=Z
  1.  ;
  1.  S Y=$G(^TMP("ACR",$J,"G",$E(ACRDOCNO,1,10),0))
  1.  I $$DT($P(Z,U,11))>0,$$DT($P(Z,U,11))<$$DT($P(Y,U,11)) S $P(Y,U,11)=$P(Z,U,11) ;TRAINING BEGIN DATE
  1.  I $$DT($P(Z,U,12))>0,$$DT($P(Z,U,12))>$$DT($P(Y,U,12)) S $P(Y,U,12)=$P(Z,U,12) ;TRAINING END DATE
  1.  S $P(Y,U,15)=$P(Y,U,15)+$P(Z,U,15) ;TUITION & FEES
  1.  S $P(Y,U,16)=$P(Y,U,16)+$P(Z,U,16) ;BOOKS & OTHER
  1.  S $P(Y,U,22)=$P(Y,U,22)+$P(Z,U,22) ;TRANSPORTATION COST
  1.  S $P(Y,U,23)=$P(Y,U,23)+$P(Z,U,23) ;PER DIEM
  1.  S $P(Y,U,24)=$P(Y,U,24)+$P(Z,U,24) ;OTHER EXPENSES
  1.  S $P(Y,U,25)=$P(Y,U,25)+$P(Z,U,25) ;TRAVEL MGT FEE
  1.  ;
  1.  S ^TMP("ACR",$J,"G",$E(ACRDOCNO,1,10),0)=Y
  1.  Q
  1. UNIX(ACRFILE)      ;
  1.  ;----- WRITE ^TMP GLOBAL TO UNIX FILE
  1.  ;
  1.  N %FILE,ACRCNT,ACRDOCDA,ACROUT,X
  1.  Q:'$D(^TMP("ACR",$J,"G"))
  1.  D HFS(.ACROUT,.%FILE,ACRFILE)
  1.  Q:$G(ACROUT)
  1.  U %FILE
  1.  S ACRCNT=0
  1.  S ACRDOCDA=""
  1.  F  S ACRDOCDA=$O(^TMP("ACR",$J,"G",ACRDOCDA)) Q:ACRDOCDA']""  D
  1.  . S X=$G(^TMP("ACR",$J,"G",ACRDOCDA,0))
  1.  . S ACRCNT=$G(ACRCNT)+1
  1.  . D WRITE(X)
  1.  . W !
  1.  U 0 W !!,ACRCNT_" Records have been put into file "_ACRFILE
  1.  D ^%ZISC
  1.  H 3
  1.  Q
  1. WRITE(X) ;
  1.  ;----- FORMAT AND WRITE DATA TO UNIX FILE
  1.  ;
  1.  N I,Y
  1.  ;
  1.  F I=1:1:$L(X,U) D
  1.  . S Y=$P(X,U,I)
  1.  . W """"
  1.  . W Y
  1.  . W """"
  1.  . W ","
  1.  Q
  1. DATES(ACRDATES)    ;
  1.  ;----- ASK DATE RANGE
  1.  ;
  1. DLOOP ;----- DATE LOOP   
  1.  ;
  1.  N ACRBEG,ACREND,DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  W !
  1.  S DIR(0)="DO^::E"
  1.  S DIR("A")="Start with first TRAINING BEGIN DATE"
  1.  S DIR("?")="The first BEGINNING DATE OF TRAINING to include in the report"
  1.  D ^DIR
  1.  Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
  1.  Q:Y=""
  1.  S ACRBEG=Y
  1.  S DIR("A")="End with last TRAINING BEGIN DATE"
  1.  S DIR("?")="The last BEGINNING DATE OF TRAINING to include in the report"
  1.  D ^DIR
  1.  Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
  1.  Q:Y=""
  1.  S ACREND=Y
  1.  I ACREND<ACRBEG D  G DLOOP
  1.  . W *7,!?5,"ENDING DATE cannot be less than BEGINNING DATE"
  1.  S ACRDATES=ACRBEG_U_ACREND
  1.  Q
  1. FILE(ACRFILE)      ;
  1.  ;----- ASK FILE NAME
  1.  ;
  1.  N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  S ACRFILE=""
  1.  S DIR(0)="F"
  1.  S DIR("A")="Select OUTPUT FILE NAME"
  1.  S DIR("?")="The name of the OUTPUT FILE you want to put the data into"
  1.  D ^DIR
  1.  Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
  1.  S ACRFILE=Y_".csv"
  1.  Q
  1. HFS(ACROUT,%FILE,ACRFILE)    ;
  1.  ;----- CREATE AND OPEN FILE
  1.  ;
  1.  N POP,X,Y,ZISH1,ZISH2,ZISH3,ZISH4
  1.  S ZISH1="FILE"
  1.  ;S ZISH2="/usr/ACR/alb/"                   ;ACR*2.1*13.06 IM14144
  1.  S ZISH2=$$ARMSDIR^ACRFSYS(1)               ;ACR*2.1*13.06 IM14144
  1.  S ZISH3=ACRFILE
  1.  S ZISH4="W"
  1.  D OPEN^%ZISH(ZISH1,ZISH2,ZISH3,ZISH4)
  1.  I POP D  Q
  1.  . W "CANNOT OPEN FILE "_ZISH2_ZISH3
  1.  . S ACROUT=1
  1.  S %FILE=IO
  1.  Q
  1. LOC(X) ;----- RETURN INTERNAL LOCATION IEN OF TRAVELER OFFICIAL DUTY STATION
  1.  ;
  1.  ;      X  =  TRAVELER IEN
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X S Y=$P($G(^ACRAU(X,1)),U)
  1.  Q Y
  1. ASUFAC(D0)         ;
  1.  ;----- RETURN LOCATION ASUFAC CODE
  1.  ;
  1.  ;      D0 =  LOCATION IEN
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I D0 X $G(^DD(9999999.06,.0799,9.2))
  1.  S Y=$P($G(Y(9999999.06,.0799,3)),U,10)
  1.  Q Y
  1. CAN(ACRDOCDA)      ;
  1.  ;----- RETURN EXTERNAL CAN NUMBER
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  S Y=$P($G(^ACRDOC(ACRDOCDA,"REQ")),U,10)
  1.  I Y S Y=$P($G(^ACRCAN(Y,0)),U)
  1.  I Y S Y=$P($G(^AUTTCAN(Y,0)),U)
  1.  Q Y
  1. NAME(ACRDOCDA)     ;
  1.  ;----- RETURN EXTERNAL TRAINEE NAME
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  S Y=$P($G(^ACRDOC(ACRDOCDA,"TRNG")),U,2)
  1.  ;I Y S Y=$P($G(^VA(200,Y,0)),U)  ;ACR*2.1*19.02 IM16848
  1.  I Y S Y=$$NAME2^ACRFUTL1(Y)  ;ACR*2.1*19.02 IM16848
  1.  Q Y
  1. AMTS(ACRDOCDA)     ;
  1.  ;----- BUILDS TUITION & FEES, BOOKS & OTHER, TRAVEL, PER DIEM,
  1.  ;      OTHER EXP, TRAVEL MGT FEE ARRAY
  1.  ;
  1.  N ACRAMT,ACRD0,ACRDATA,ACRDOCNO,ACRKW,X
  1.  ;
  1.  S ACRDOCNO=$P($G(^ACRDOC(ACRDOCDA,0)),U)
  1.  Q:ACRDOCNO']""
  1.  S ACRD0=0
  1.  F  S ACRD0=$O(^ACRSS("C",ACRDOCDA,ACRD0)) Q:'ACRD0  D
  1.  . S ACRKW=$P($G(^ACRSS(ACRD0,"NMS")),U,5)
  1.  . Q:ACRKW']""
  1.  . S ACRDATA=$G(^ACRSS(ACRD0,"DT"))
  1.  . S ACRAMT=$P(ACRDATA,U,4)
  1.  . I $P($G(^ACRSS(ACRD0,"APV")),U,2)="A" D
  1.  . . S ACRAMT=$P(ACRDATA,U,9)
  1.  . S ^TMP("ACR",$J,"AMT",ACRDOCNO,ACRKW,0)=ACRAMT
  1.  Q
  1. STAT(ACRDOCDA)     ;
  1.  ;----- RETURNS DOCUMENT STATUS
  1.  ;
  1.  N Y
  1.  S Y=$P($G(^ACROBL(ACRDOCDA,"APV")),U)
  1.  S Y="350 "_$S(Y="A":"APPROVED",Y="D":"DISAPPROVED",Y="C":"CANCELLED",1:"PENDING")
  1.  Q Y
  1. TXT ;----- PRINT OPTION TEXT
  1.  ;
  1.  N I,X
  1.  F I=1:1 S X=$P($T(DESC+I),";",3) Q:X["$$END"  W !,X
  1.  Q
  1. DT(X) ;----- RETURNS FM DATE
  1.  ;
  1.  ;      X = EXTERNAL DATE, IE., 01/10/2002
  1.  ;
  1.  N Y
  1.  S %DT=""
  1.  D ^%DT
  1.  Q Y
  1. DOCNO(X) ;----- RETURNS DOCUMENT NUMBER 
  1.  ;
  1.  ;      X  =  DOCUMENT IEN
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X S Y=$P($G(^ACRDOC(X,0)),U)
  1.  Q Y
  1. TVLF(X) ;----- RETURNS EXTERNAL TRAVEL FROM CITY^STATE  
  1.  ;
  1.  ;      X  =  DOCUMENT IEN
  1.  ;
  1.  N Y,Z
  1.  S Y=""
  1.  I X S Z=$P($G(^ACRDOC(X,13)),U)
  1.  S Y=$$CITY(Z)
  1.  Q Y
  1. TVLT(X) ;----- RETURNS EXTERNAL TRAVEL TO CITY^STATE 
  1.  ;
  1.  ;      X  =  DOCUMENT IEN
  1.  ;
  1.  N Y,Z
  1.  S Y=""
  1.  I X S Z=$O(^ACRDOC(X,9,0))
  1.  I Z S Z=$P($G(^ACRDOC(X,9,Z,0)),U)
  1.  I Z S Y=$$CITY(Z)
  1.  Q Y
  1. CITY(X) ;----- RETURNS EXTERNAL ARMS PER DIEM CITY^STATE
  1.  ;
  1.  ;      X  =  PER DIEM CITY IEN
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X S X=$G(^ACRPD(X,0))
  1.  S Y=$P(X,U)
  1.  S X=$P(X,U,2)
  1.  I X S X=$P($G(^DIC(5,X,0)),U,2)
  1.  S Y=Y_U_X
  1.  Q Y
  1. ODS(X) ;----- RETURNS OFFICIAL DUTY STATION
  1.  ;
  1.  ;      X  =  TRAVELER
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X S Y=$P($G(^ACRAU(X,1)),U)
  1.  I Y S Y=$P($G(^AUTTLOC(Y,0)),U)
  1.  I Y S Y=$P($G(^DIC(4,Y,0)),U)
  1.  Q Y
  1. ODSA(X) ;----- RETURNS OFFICIAL DUTY STATION AREA
  1.  ;
  1.  ;      X  =  TRAVELER
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X S Y=$P($G(^ACRAU(X,1)),U)
  1.  I Y S Y=$P($G(^AUTTLOC(Y,0)),U,4)
  1.  I Y S Y=$P($G(^AUTTAREA(Y,0)),U)
  1.  Q Y
  1. SEX(X) ;----- RETURNS GENDER
  1.  ;
  1.  ;      X  =  TRAVELER
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X S Y=$P($G(^VA(200,X,1)),U,2)
  1.  Q Y
  1. PAYPLAN(X) ;----- RETURNS PAY PLAN OF TRAVELER
  1.  ;
  1.  ;      X  =  TRAVELER
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X S X=$G(^ACRAU(X,1))
  1.  S Y=$P(X,U,3)
  1.  Q Y
  1. GRADE(X) ;----- RETURNS GRADE OF TRAVELER
  1.  ;
  1.  ;      X  =  TRAVELER
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X S X=$G(^ACRAU(X,1))
  1.  S Y=$P(X,U,4)
  1.  Q Y
  1. SER(X) ;----- RETURNS SERIES OF TRAVELER
  1.  ;
  1.  ;      X  =  TRAVELER
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X S Y=$P($G(^ACRAU(X,1)),U,8)
  1.  Q Y
  1. BEG(X) ;----- RETURNS TRAINING BEGIN DATE
  1.  ;
  1.  ;      X  =  DOCUMENT IEN
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X S Y=$P($G(^ACRDOC(X,"TRNG")),U,11)
  1.  I Y S Y=$$SLDATE^ACRFUTL(Y)
  1.  Q Y
  1. END(X) ;----- RETURNS TRAINING END DATE
  1.  ;
  1.  ;      X  =  DOCUMENT IEN
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X S Y=$P($G(^ACRDOC(X,"TRNG")),U,12)
  1.  I Y S Y=$$SLDATE^ACRFUTL(Y)
  1.  Q Y
  1. TITLE(X) ;----- RETURNS TRAINING COURSE TITLE
  1.  ;
  1.  ;      X  =  DOCUMENT IEN
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X S Y=$P($G(^ACRDOC(X,"TRNG")),U,18)
  1.  Q Y
  1. HRS(X) ;----- RETURNS TRAINING HOURS (DUTY)
  1.  ;
  1.  ;      X  =  DOCUMENT IEN
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X S Y=$P($G(^ACRDOC(X,"TRNG")),U,9)
  1.  Q Y