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

ACRFFF3.m

Go to the documentation of this file. 
  1. ACRFFF3 ;IHS/OIRM/DSD/AEF - PRODUCE FLAT FILE OF TRAVEL 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 Travel Information Flat File
  1.  ;;
  1.  ;;This option will gather all travel 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                 12 Travel End Date
  1.  ;;     2 CAN Number                  13 Days in Travel
  1.  ;;     3 Travel Order Number         14 Travel From City
  1.  ;;     4 Traveler Name               15 Travel From State
  1.  ;;     5 Official Duty Station       16 Travel To City
  1.  ;;     6 ODS Area                    17 Travel To State
  1.  ;;     7 Gender                      18 Amount Requested
  1.  ;;     8 Pay Plan                    19 Amount Obligated
  1.  ;;     9 Grade                       20 Amount Spent
  1.  ;;    10 Series                      21 Status
  1.  ;;    11 Travel Begin Date           22 Purpose of Travel
  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,"T")) D  Q
  1.  . W !!,"No data found"
  1.  . D PAUSE^ACRFWARN
  1.  ;
  1.  D UNIX(ACRFILE)
  1.  ;
  1.  ;K ^TMP("ACR",$J,"T")
  1.  ;
  1.  D ^%ZISC
  1.  ;
  1.  D PAUSE^ACRFWARN
  1.  ;
  1.  Q
  1. GET(ACRDATES)      ;
  1.  ;----- LOOP THROUGH TRAVEL ORDERS AND PUT DATA INTO ^TMP GLOBAL
  1.  ;
  1.  N ACRDATA,ACRDOCDA,ACRREF,ACRTOREF,ACRTVREF
  1.  ;
  1.  K ^TMP("ACR",$J,"T")
  1.  K ^TMP("ACR",$J,"D")
  1.  ;
  1.  S ACRTOREF=$O(^AUTTDOCR("B",130,0))
  1.  S ACRTVREF=$O(^AUTTDOCR("B",600,0))
  1.  F ACRREF=ACRTOREF,ACRTVREF D
  1.  . S ACRDOCDA=0
  1.  . F  S ACRDOCDA=$O(^ACRDOC("REF",ACRREF,ACRDOCDA)) Q:'ACRDOCDA  D
  1.  . . S ACRDATA=$G(^ACRDOC(ACRDOCDA,"TO"))
  1.  . . Q:$P(ACRDATA,U,14)<$P(ACRDATES,U)
  1.  . . Q:$P(ACRDATA,U,14)>$P(ACRDATES,U,2)
  1.  . . D ONE(ACRDOCDA,ACRDATES,ACRREF)
  1.  Q
  1. ONE(ACRDOCDA,ACRDATES,ACRREF)          ; 
  1.  ;----- GATHER DATA FOR ONE DOCUMENT AND PUT INTO ^TMP GLOBAL         
  1.  ;
  1.  N ACRDOCNO,ACRTVLR
  1.  ;
  1.  ;DOCUMENT NUMBER
  1.  S ACRDOCNO=$P($G(^ACRDOC(ACRDOCDA,0)),U)
  1.  ;
  1.  ;TRAVELER IEN
  1.  S ACRTVLR=$$TVLR(ACRDOCDA)
  1.  ;
  1.  ;TRAVEL DAYS
  1.  D TDAYS(ACRDOCDA,ACRDOCNO)
  1.  ;
  1.  I $L(ACRDOCNO)>10 D  Q   ;ADD AMENDMENTS TO ORIGINAL DOCUMENT TOTALS
  1.  . D SETAMT(ACRDOCDA,ACRDOCNO)
  1.  . D SETTD(ACRDOCNO)
  1.  ;
  1.  D SET(ACRDOCDA,ACRDOCNO,ACRTVLR)
  1.  D SETAMT(ACRDOCDA,ACRDOCNO)
  1.  D SETTD(ACRDOCNO)
  1.  Q
  1. SET(ACRDOCDA,ACRDOCNO,ACRTVLR)         ;
  1.  ;----- SET DATA INTO ^TMP GLOBAL
  1.  ;
  1.  N X
  1.  ;
  1.  S X=$G(^TMP("ACR",$J,"T",$E(ACRDOCNO,1,10),1,0))
  1.  S $P(X,U)=$$ASUFAC($$LOC(ACRTVLR))
  1.  S $P(X,U,2)=$$CAN(ACRDOCDA)
  1.  S $P(X,U,3)=ACRDOCNO
  1.  S $P(X,U,4)=$$NAME(ACRTVLR)
  1.  S $P(X,U,5)=$$ODS(ACRTVLR)
  1.  S $P(X,U,6)=$$ODSA(ACRTVLR)
  1.  S $P(X,U,7)=$$SEX(ACRTVLR)
  1.  S $P(X,U,8)=$$PAYPLAN(ACRTVLR)
  1.  S $P(X,U,9)=$$GRADE(ACRTVLR)
  1.  S $P(X,U,10)=$$SER(ACRTVLR)
  1.  S $P(X,U,14)=$P($$TVLF(ACRDOCDA),U)
  1.  S $P(X,U,15)=$P($$TVLF(ACRDOCDA),U,2)
  1.  S $P(X,U,16)=$P($$TVLT(ACRDOCDA),U)
  1.  S $P(X,U,17)=$P($$TVLT(ACRDOCDA),U,2)
  1.  S $P(X,U,21)=$$STAT(ACRDOCDA)
  1.  S ^TMP("ACR",$J,"T",$E(ACRDOCNO,1,10),1,0)=X
  1.  S ^TMP("ACR",$J,"T",$E(ACRDOCNO,1,10),2,0)=$$PURP(ACRDOCDA)
  1.  Q
  1. SETAMT(ACRDOCDA,ACRDOCNO)    ;
  1.  ;----- SET AMOUNTS INTO ^TMP GLOBAL
  1.  ;
  1.  N X
  1.  ;
  1.  S X=$G(^TMP("ACR",$J,"T",$E(ACRDOCNO,1,10),1,0))
  1.  S $P(X,U,18)=$$DOL^ACRFUTL($P(X,U,18)+$$REQ(ACRDOCDA))
  1.  S $P(X,U,19)=$$DOL^ACRFUTL($P(X,U,19)+$$OBL(ACRDOCDA))
  1.  S $P(X,U,20)=$$DOL^ACRFUTL($P(X,U,20)+$$SPNT(ACRDOCDA))
  1.  S ^TMP("ACR",$J,"T",$E(ACRDOCNO,1,10),1,0)=X
  1.  Q
  1. SETTD(ACRDOCNO)    ;
  1.  ;----- SETS 1ST AND LAST TRAVEL DAYS INTO ^TMP GLOBAL
  1.  ;
  1.  N ACRF,ACRL,ACRN,X
  1.  ;
  1.  S X=$G(^TMP("ACR",$J,"T",$E(ACRDOCNO,1,10),1,0))
  1.  S ACRF=$O(^TMP("ACR",$J,"D",$E(ACRDOCNO,1,10),0))
  1.  S ACRL=$O(^TMP("ACR",$J,"D",$E(ACRDOCNO,1,10),9999999),-1)
  1.  S ACRN=$$NTDAYS(ACRL,ACRF)
  1.  S $P(X,U,11)=$$SLDATE^ACRFUTL(ACRF)
  1.  S $P(X,U,12)=$$SLDATE^ACRFUTL(ACRL)
  1.  S $P(X,U,13)=ACRN
  1.  S ^TMP("ACR",$J,"T",$E(ACRDOCNO,1,10),1,0)=X
  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,"T"))
  1.  D HFS(.ACROUT,.%FILE,ACRFILE)
  1.  Q:$G(ACROUT)
  1.  U %FILE
  1.  S ACRCNT=0
  1.  S ACRDOCDA=0
  1.  F  S ACRDOCDA=$O(^TMP("ACR",$J,"T",ACRDOCDA)) Q:'ACRDOCDA  D
  1.  . S ACRCNT=$G(ACRCNT)+1
  1.  . S X=$G(^TMP("ACR",$J,"T",ACRDOCDA,1,0))
  1.  . D WRITE(X)
  1.  . S X=$G(^TMP("ACR",$J,"T",ACRDOCDA,2,0))
  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.  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 TRAVEL BEGIN DATE"
  1.  S DIR("?")="The first BEGINNING DATE OF TRAVEL 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 TRAVEL BEGIN DATE"
  1.  S DIR("?")="The last BEGINNING DATE OF TRAVEL 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) ;----- RETURNS 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(X) ;----- RETURN EXTERNAL CAN NUMBER
  1.  ;
  1.  ;      X  =  DOCUMENT IEN
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X S Y=$P($G(^ACRDOC(X,"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. TVLR(X) ;----- RETURN TRAVELER IEN
  1.  ;
  1.  ;      X  =  DOCUMENT IEN
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X S Y=$P($G(^ACRDOC(X,"TO")),U,9)
  1.  Q Y
  1. NAME(X) ;----- RETURN EXTERNAL TRAVELER NAME
  1.  ;
  1.  ;      X  =  TRAVELER IEN
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  ;I X S Y=$P($G(^VA(200,X,0)),U)  ;ACR*2.1*19.02 IM16848
  1.  I X S Y=$$NAME2^ACRFUTL1(X)  ;ACR*2.1*19.02 IM16848
  1.  Q Y
  1. TDAYS(ACRDOCDA,ACRDOCNO)     ;
  1.  ;----- BUILDS TRAVEL DAY ARRAY
  1.  ;
  1.  N X,Y,Z
  1.  S Y=""
  1.  S X=0
  1.  F  S X=$O(^ACRTV("D",ACRDOCDA,X)) Q:'X  D
  1.  . S Z=$P($G(^ACRTV(X,"DT")),U)
  1.  . Q:'Z
  1.  . S ^TMP("ACR",$J,"D",$E(ACRDOCNO,1,10),Z,0)=$$SLDATE^ACRFUTL(Z)
  1.  Q
  1. NTDAYS(X1,X2)      ;
  1.  ;----- RETURN TRAVEL TRAVEL DAYS
  1.  ;
  1.  N %Y,X,Y
  1.  S Y=""
  1.  D ^%DTC
  1.  I %Y S Y=X
  1.  Q Y
  1. TVLF(X) ;----- RETURNS EXTERNAL TRAVEL FROM CITY^STATE
  1.  ;
  1.  ;      X  =  DOCUMENT IEN
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X S X=$P($G(^ACRDOC(X,13)),U)
  1.  I X S Y=$$CITY(X)
  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  =  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. PURP(X) ;----- RETURN PURPOSE OF TRAVEL
  1.  ;
  1.  ;      X  =  DOCUMENT IEN
  1.  ;
  1.  N I,G,Y,Z
  1.  S Y=""
  1.  F G="JST","JST2" D
  1.  . S Z=$G(^ACROBL(X,G))
  1.  . F I=1:1:5 D
  1.  . . I $P(Z,U,I)]"" S Y=Y_" "_$P(Z,U,I)
  1.  Q Y
  1. STAT(X) ;----- RETURNS DOCUMENT STATUS
  1.  ;
  1.  ;      X  =  DOCUMENT IEN
  1.  ;
  1.  N ACRREF,Y,Z
  1.  S Y=""
  1.  S Z=$G(^ACRDOC(X,0))
  1.  I $L($P(Z,U))'=10 Q Y
  1.  S ACRREF=$P(Z,U,13)
  1.  I ACRREF S ACRREF=$P($G(^AUTTDOCR(ACRREF,0)),U)
  1.  S Z=$G(^ACROBL(X,"APV"))
  1.  I ACRREF=130 S Z=$P(Z,U),Y="TO"
  1.  I ACRREF=600 S Z=$P(Z,U,8),Y="TV"
  1.  I $P($G(^ACRDOC(X,0)),U,14)["CANCELLED" S Z="C"
  1.  S Y=Y_$S(Z="A":" APPROVED",Z="D":" DISAPPROVED",Z="C":" CANCELLED",1:" PENDING")
  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)         ;
  1.  ;----- 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. ODS(X) ;----- RETURNS OFFICAL 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. REQ(X) ;----- RETURNS AMOUNT REQUESTED
  1.  ;
  1.  ;      X  =  DOCUMENT IEN
  1.  N Y
  1.  S Y=""
  1.  I X S Y=$P($G(^ACROBL(X,0)),U)
  1.  Q Y
  1. OBL(X) ;----- RETURNS AMOUNT OBLIGATED
  1.  ;
  1.  ;      X  =  DOCUMENT IEN
  1.  N Y
  1.  S Y=""
  1.  I X S Y=$P($G(^ACROBL(X,"DT")),U,4)
  1.  Q Y
  1. SPNT(X) ;----- RETURNS AMOUNT SPENT
  1.  ;
  1.  ;      X  =  DOCUMENT IEN
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X S Y=$P($G(^ACROBL(X,"DT")),U,2)
  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