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

ACRFUTL.m

Go to the documentation of this file. 
  1. ACRFUTL ;IHS/OIRM/DSD/AEF - VARIOUS UTILITY SUBROUTINES [ 10/27/2004  4:17 PM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,13,14**;NOV 05, 2001
  1.  ;
  1. PAD(X,S,L,C)       ;EP
  1.  ;----- PAD MACHINE - PAD CHARACTER STRING
  1.  ;
  1.  ;      X = DATA STRING
  1.  ;      S = L=PADLEFT, R=PADRIGHT
  1.  ;      L = LENGTH
  1.  ;      C = PAD CHARACTER
  1.  ;
  1.  I $L(X)>L S X=$E(X,1,L) Q X
  1.  S X=$TR(X," ","~")
  1.  I S="R" D
  1.  . S X=X_$J("",L-$L(X))
  1.  I S="L" D
  1.  . S X=$J("",L-$L(X))_X
  1.  I C]"" S X=$TR(X," ",C)
  1.  S X=$TR(X,"~"," ")
  1.  Q X
  1.  ;
  1. AREA(X) ;EP -- RETURNS INTERNAL AREA SYSTEM FOR FMS SUPPLIES AND SERVICES FILE
  1.  ;
  1.  ;      Used by Function ACRFSSAREA, which is used by trigger on
  1.  ;      COMMON ACCOUNTING NUMBER field of FMS Supplies and Services file
  1.  ;      to trigger the AREA SYSTEM field.
  1.  ;
  1.  ;      Input:
  1.  ;      X  =  IEN OF FMS SUPPLIES AND SERVICES FILE ENTRY
  1.  ;
  1.  ;      Output:
  1.  ;      X  =  INTERNAL AREA IN FMS SYSTEM DEFAULTS FILE
  1.  ;
  1.  I $P($G(^ACRSS(X,0)),U,5)="" S X="" Q X
  1.  I $P($G(^ACRCAN($P($G(^ACRSS(X,0)),U,5),0)),U,7)="" S X="" Q X
  1.  I $P($G(^AUTTLCOD($P($G(^ACRCAN($P($G(^ACRSS(X,0)),U,5),0)),U,7),0)),U,3)="" S X="" Q X
  1.  S X=$P($G(^AUTTACPT($P($G(^AUTTLCOD($P($G(^ACRCAN($P($G(^ACRSS(X,0)),U,5),0)),U,7),0)),U,3),0)),U,2)
  1.  S X=$O(^ACRSYS("B",X,0))
  1.  I 'X S X=""
  1.  Q X
  1.  ;
  1. SYS(X) ;EP -- RETURNS FMS SYSTEM DEFAULTS ENTRY IEN FOR PURCHASING OFFICE
  1.  ;
  1.  ;      X = FMS PURCHASING OFFICE IEN
  1.  ;
  1.  N Y
  1.  S Y=1
  1.  I 'X Q Y
  1.  I '$P($G(^ACRPO(X,0)),U,19) Q Y
  1.  S Y=$P(^ACRPO(X,0),U,19)
  1.  Q Y
  1. TCMD(X,Y)          ;EP
  1.  ;----- ENTRY POINT FOR USING $$TERMINAL^%HOSTCMD
  1.  ;    (ALSO REPLACES HOSTCMD^AFSLCKZC CALL)
  1.  ;
  1.  ;      RETURNS 0 IF VALID, 1 IF INVALID
  1.  ;
  1.  S Y=$$TERMINAL^%HOSTCMD(X)
  1.  Q
  1. JCMD(X,Y)          ;EP
  1.  ;----- ENTRY POINT FOR USING $$JOBWAIT^%HOSTCMD
  1.  ;
  1.  ;      RUNS IN BACKGROUND - WILL WORK IN CACHE'
  1.  ;      RETURNS 0 IF VALID, 1 IF INVALID
  1.  ;
  1.  S Y=$$JOBWAIT^%HOSTCMD(X)
  1.  Q
  1. JDATE() ;EP -- RETURNS TODAY'S JULIAN DATE
  1.  ;
  1.  N X,X1,X2
  1.  D ^XBKVAR
  1.  S X1=DT
  1.  S X2=$E(DT,1,3)_"0101"
  1.  D ^%DTC
  1.  S X=X+1
  1.  S X=$$PAD(X,"L",3,0)
  1.  Q X
  1. QUE(ZTRTN,ZTSAVE,ZTDESC)     ;EP;
  1.  ;----- QUEUEING CODE FROM WITHIN ROUTINES
  1.  ;
  1.  N %ZIS,IO,POP,ZTIO,ZTSK
  1.  S %ZIS="Q"
  1.  D ^%ZIS
  1.  Q:POP
  1.  I $D(IO("Q")) D  Q
  1.  . K IO("Q")
  1.  . S ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
  1.  . D ^%ZTLOAD
  1.  . W !,"Task #",$G(ZTSK)," queued"
  1.  D @ZTRTN
  1.  Q
  1. NOW() ;EP -- RETURNS CURRENT DATE/TIME
  1.  ;
  1.  N %,%H,%I,X
  1.  D ^XBKVAR
  1.  D NOW^%DTC
  1.  S Y=DT
  1.  X ^DD("DD")
  1.  Q Y_" "_$E($P(%,".",2),1,2)_":"_$E($P(%,".",2),3,4)
  1.  ;
  1. SLDATE(X)          ;EP
  1.  ;----- RETURNS DATE IN MM/DD/YYYY FORMAT
  1.  ;
  1.  ;      X = INTERNAL FILEMANAGER DATE IN YYYMMDD FORMAT
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X D
  1.  . Q:$L(X)'=7
  1.  . S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_($E(X,1,3)+1700)
  1.  Q Y
  1. DOL(X) ;EP -- FORMAT DOLLAR AMOUNT ;
  1.  ;
  1.  ;      RETURNS X IN 999.99 FORMAT
  1.  ;
  1.  I X["(" S X=$TR(X,"()",""),X="-"_X
  1.  S X=$FN(X,"P",2)
  1.  S X=$TR(X," ","")
  1.  I X["(" S X=$TR(X,"()",""),X="-"_X
  1.  Q X
  1. FY(X) ;EP -- CALCULATE FISCAL YEAR
  1.  ;
  1.  ;      RETURNS FISCAL YEAR IN X
  1.  ;
  1.  N MON
  1.  S MON=$E(X,4,5)
  1.  S X=$E(X,1,3)
  1.  S X=1700+X
  1.  I +MON>9 S X=X+1
  1.  Q X
  1. UPPER(X) ;EP -- CONVERT STRING TO UPPERCASE ;
  1.  ;
  1.  X ^%ZOSF("UPPERCASE")
  1.  Q Y
  1.  ;
  1. HFS(ZISH1,ZISH2,ZISH3,%FILE) ;EP ;
  1.  ;----- CREATE AND OPEN UNIX FILE - SILENT & NO "FILE"
  1.  ;
  1.  ; *NOTE: OPEN^%ZISH IS EXTRINSIC FUNCTION WHEN IT HAS ONLY 3 PARAMS
  1.  ;        MUST 'DO' THE CALL WHEN PASSING 4 OR MORE
  1.  ;
  1.  ;      ENTERS WITH: ZISH1= PATH
  1.  ;                   ZISH2= FILENAME
  1.  ;                   ZISH3= "R" OR "W"
  1.  ;      RETURNS: %FILE = DEVICE NUMBER (or UNDEFINED) 
  1.  ;
  1.  ;
  1.  N X,Y
  1.  ;S Y=$$OPEN^%ZISHMSM(ZISH1,ZISH2,ZISH3)   ;ACR*2.1*13.01 IM13574
  1.  S Y=$$OPEN^%ZISH(ZISH1,ZISH2,ZISH3)       ;ACR*2.1*13.01 IM13574
  1.  Q:Y
  1.  S %FILE=IO
  1.  Q
  1. DOC(X) ;EP -- CONVERT REQUISITION NUMBER
  1.  ;
  1.  ;      INPUT:
  1.  ;      X  =  REQUISITION NUMBER
  1.  ;
  1.  ;      RETURNS: THE 10 DIGIT REQUISITION NUMBER WITHOUT THE DASHES
  1.  ;
  1.  S X=$TR(X,"-","")
  1.  S X=$E(X,2,11)
  1.  Q X
  1. HOST() ;EP -- RETURNS HOST NAME ; ACR*2.1*13.02 IM13574
  1.  N Y
  1.  S Y=""
  1.  S Y=$P(^AUTTSITE(1,0),U,14)
  1.  S Y=$TR(Y,"-")
  1.  Q Y
  1. PSSN(X,DUZ,IOST,ACRSSNOK)    ;EP  ;ACR*2.1*3.36
  1.  ;----- OUTPUT TRANSFORM FOR TRAVEL ORDER/TRAVEL VOUCHER/TRAINING
  1.  ;      REQUEST PRINT TEMPLATES
  1.  ;
  1.  ;      INPUT VARIABLES:
  1.  ;      X        =  EMPLOYEE IEN
  1.  ;      DUZ      =  PERSON PRINTING REPORT
  1.  ;      IOST     =  PRINT SUBTYPE
  1.  ;      ACRSSNOK =  VARIABLE SET IN ACRFPRNT AUTOPRINT ROUTINE
  1.  ;
  1.  ;      OUTPUT:
  1.  ;      Y        = SSN IN 999-99-9999 OR ***-**-**** FORMAT
  1.  ;
  1.  ;      PRINT LOGIC:
  1.  ;      NEVER PRINT TO TERMINAL SCREEN
  1.  ;      ALWAYS PRINT SSN IF DOCUMENT IS AUTOPRINTED DUE TO APPROVAL
  1.  ;      IF NOT AUTOPRINTED, ONLY PRINT IF THE USER HAS SECURITY KEY
  1.  ;
  1.  N Y
  1.  S Y="*********"
  1.  I "S-P-"[$E($G(IOST),1,2) D
  1.  . Q:'$G(ACRSSNOK)&'$D(^XUSEC("ACRFZ SSN",+$G(DUZ)))
  1.  . I $P($G(^VA(200,+$G(X),1)),U,9) S Y=$P(^(1),U,9)
  1.  S Y=$E(Y,1,3)_"-"_$E(Y,4,5)_"-"_$E(Y,6,9)
  1.  Q Y
  1. ASKAP(ACRAP)       ;EP;             NEW SUB-ROUTINE ACR*2.1*13.02
  1.  ;----- SELECT ACCOUNTING POINT FROM LIST
  1.  ;     ------RETURNS INTERNAL AND EXTERNAL VALUES
  1.  ;
  1.  N DIC,X,Y
  1.  S ACRAP=""
  1.  S DIC="^AUTTACPT("
  1.  S DIC(0)="AEMQ"
  1.  D ^DIC
  1.  Q:$D(DTOUT)!($D(DUOUT))!(+Y'>0)
  1.  S ACRAP=Y
  1.  Q
  1.  ;
  1. AP(X) ;EP;             NEW SUB-ROUTINE ACR*2.1*13.02
  1.  ;------------EXTRINSIC FUNCTION FOR ACCOUNTING POINT
  1.  ;
  1.  N Y
  1.  Q $P($G(^AUTTACPT(X,0)),U)
  1.  ;
  1. EXPDN(X) ;EP -- RETURN EXPANDED DOCUMENT NUMBER - ACR*2.1*14.01 IM12272
  1.  ;
  1.  ;      INPUT:
  1.  ;      X  =  DOCUMENT IEN
  1.  ;
  1.  ;      OUTPUT:
  1.  ;      Y  =  EXPANDED DOCUMENT NUMBER
  1.  ;            IN FORMAT:
  1.  ;            "HHS"_"I"_CONTRACTLOCATION_4FY_DOCNO
  1.  ;
  1.  ;      NOTE:  If "< UNKNOWN XXX >" is returned it is most likely
  1.  ;             due to the following:
  1.  ;             UNKNOWN 001 = discrepancy in the fiscal year of 
  1.  ;             the document and the expanded number could not be
  1.  ;             calculated based on the available data.  In this 
  1.  ;             case, the expanded number should be manually
  1.  ;             entered into the expanded document number field of
  1.  ;             the FMS DOCUMENT file for the document.
  1.  ;
  1.  N Y,Z
  1.  S Y=""
  1.  S Z=$G(^ACRSYS(1,601))
  1.  I X,+Z,$P(Z,U,2) D
  1.  . S Z=$G(^ACRDOC(X,0))
  1.  . S Y=$P(Z,U,2)                    ;PO/CONTRACT NO
  1.  . I "148^600^130"[$$REF(X) D
  1.  . . S Y=$P(Z,U)                    ;DOCUMENT NO
  1.  . S Z=$P($G(^ACRDOC(X,"X")),U)     ;IF EXPDN ALREADY EXISTS
  1.  . I Z]"" S Y=Z Q
  1.  . Q:Y']""
  1.  . S Z=$P($G(^ACRDOC(X,0)),U,15)    ;ORIG DOCNO IF MOD
  1.  . I Z S X=Z
  1.  . S Z=$P($G(^ACRSYS(1,601)),U)
  1.  . I Z S Z=$P($G(^ACRCLC(+Z,0)),U)  ;CONTRACT LOCATION CODE
  1.  . Q:Z']""
  1.  . Q:$E($$DOCYR(X),4)'=$E(Y)
  1.  . S Z="HHS"_"I"_Z_$$DOCYR(X)_$E(Y,2,10)
  1.  . Q:$L(Z)'=20
  1.  . Q:$D(^ACRDOC("B",Z))
  1.  . S Y=Z
  1.  Q Y
  1. DOCYR(X) ;EP -- RETURN DOCUMENT YEAR - ACR*2.1*14.01 IM12272
  1.  ;
  1.  ;      This subroutine calculates the document year based
  1.  ;      on code logic in the DOC3^ACRFDOCN routine:
  1.  ;      If the fiscal year in which the document is created is
  1.  ;      greater than the fiscal year of funds (in the FMS
  1.  ;      DEPARTMENT ACCOUNT file), use the fiscal year in which
  1.  ;      the document is created, otherwise use the fiscal year
  1.  ;      of funds.
  1.  ;
  1.  ;      INPUT:
  1.  ;      X  =  DOCUMENT IEN
  1.  ;
  1.  ;      OUTPUT:
  1.  ;      Y  =  DOCUMENT YEAR
  1.  ;
  1.  N Y,Z
  1.  S Y=""
  1.  I X D
  1.  . S Y=$P($G(^ACRLOCB($$DEPT(X),"DT")),U) ;FYFUN
  1.  . S Z=$P($G(^ACRDOC(X,"PO")),U)          ;DATE OF PO
  1.  . I Z="" S Z=$P($G(^ACRDOC(X,0)),U,3)    ;DOCUMENT DATE
  1.  .  S Z=$$FY(Z)
  1.  . I Z>Y S Y=Z
  1.  Q Y
  1. YEAR(X) ;EP -- RETURN 4 DIGIT YEAR OF DATE - ACR*2.1*14.01 IM12272
  1.  ;
  1.  ;      INPUT:
  1.  ;      X  =  YEAR IN INTERNAL FILEMAN FORMAT
  1.  ;
  1.  ;      OUTPUT:
  1.  ;      Y  =  4 DIGIT YEAR
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X D
  1.  . Q:$L(X)'=7
  1.  . S Y=$E(X,1,3)+1700
  1.  Q Y
  1. DEPT(X) ;EP -- RETURN INTERNAL DEPARTMENT ACCOUNT OF DOCUMENT ;ACR*2.1*14.01 IM12272
  1.  ;
  1.  ;      INPUT:
  1.  ;      X  =  DOCUMENT IEN
  1.  ;
  1.  ;      OUTPUT:
  1.  ;      Y  =  INTERNAL DEPARTMENT ACCOUNT
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X S Y=$P($G(^ACRDOC(X,0)),U,6)
  1.  Q Y
  1. REF(X) ;EP -- RETURN EXTERNAL DOCUMENT REFERENCE CODE ;ACR*2.1*14.01 IM12272
  1.  ;
  1.  ;      INPUT:
  1.  ;      X  =  DOCUMENT IEN
  1.  ;
  1.  ;      OUTPUT:
  1.  ;      Y  =  EXTERNAL DOCUMENT REFERENCE CODE
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X S Y=$P($G(^ACRDOC(X,0)),U,13)
  1.  I Y S Y=$P($G(^AUTTDOCR(Y,0)),U)
  1.  Q Y