ACRF14PS ;IHS/PHXAO/AEF - ARMS PATCH 14 POST INSTALL ROUTINE [ 10/28/2004 11:08 AM ]
;;2.1;ADMINISTRATIVE RESOURCE MGMT SYSTEM;**14**;MAY 27, 2004
;
EN ;EP -- MAIN ENTRY POINT
;
D ^XBKVAR
D HOME^%ZIS
D COMPP
D COMPC
D POPCLC
Q
COMPP ;----- RECOMPILE PRINT TEMPLATES
;
N ACRPTEMP,I,X
;
D BMES^XPDUTL("Recompiling print templates...")
;
F I=1:1 S X=$T(PTEMP+I) Q:X["$$END" S ACRPTEMP($P(X,";;",2))=""
;
S ACRPTEMP=""
F S ACRPTEMP=$O(ACRPTEMP(ACRPTEMP)) Q:ACRPTEMP']"" D
. D ONEP(ACRPTEMP)
Q
ONEP(ACRPTEMP) ;
;----- RECOMPILE ONE PRINT TEMPLATE
;
; ACRPTEMP = PRINT TEMPLATE NAME
;
N ACRFILE,ACRIEN,DMAX,X,Y
;
S ACRFILE=$P(ACRPTEMP,U,2)
S ACRPTEMP=$P(ACRPTEMP,U)
S ACRIEN=0
F S ACRIEN=$O(^DIPT("B",ACRPTEMP,ACRIEN)) Q:'ACRIEN D
. Q:$P($G(^DIPT(ACRIEN,0)),U,4)'=ACRFILE
. S X=$P($G(^DIPT(ACRIEN,"ROU")),U,2)
. Q:X']""
. S Y=ACRIEN
. S DMAX=$$ROUSIZE^DILF
. D EN^DIPZ
Q
COMPC ;----- COMPILE CROSSREFERENCES
;
N DMAX,X,Y
;
S Y=9002196
S X=$G(^DD(Y,0,"DIK"))
Q:X']""
S DMAX=$$ROUSIZE^DILF
D EN^DIKZ
Q
POPCLC ;----- POPULATE CONTRACT LOCATION CODE AND TURN ON EXPANDED DOCUMENT
; NUMBER PRINTING
;
N ACRCLC,DA,DIE,DR,X,Y
;
D BMES^XPDUTL("Entering Contract Location Code...")
D BMES^XPDUTL("Turning on Expanded Document Number printing...")
;
S ACRCLC=$$CLC($$HOST)
I 'ACRCLC D Q
. D BMES^XPDUTL(">>> Cannot find Contract Location Code")
. D BMES^XPDUTL(">>> Cannot turn on Expanded Document Number printing")
. D BMES^XPDUTL(">>> Please update FMS System Defaults file manually")
;
S DIE="^ACRSYS("
S DA=1
S DR="601.1///^S X=ACRCLC;601.2////^S X=1"
D ^DIE
;
Q
HOST() ;----- RETURNS HOST NAME FROM RPMS SITE FILE
;
N Y
S Y=""
S Y=$P($G(^AUTTSITE(1,0)),U,14)
S Y=$TR(Y,"-")
Q Y
CLC(X) ;----- RETURNS CONTRACT LOCATION CODE
;
; X = AREA HOST NAME
;
N Y
S Y=""
S X=$E(X,1,3)
X ^%ZOSF("UPPERCASE")
S X=Y
S Y=""
I X="ABR" S Y=241
I X="AKA" S Y=243
I X="ALB" S Y=242
I X="BIL" S Y=244
I X="BJI" S Y=239
I X="CAO" S Y=235
I X="CMB" S Y=242
I X="DPS" S Y=236
I X="NAV" S Y=245
I X="NSA" S Y=285
I X="OKC" S Y=246
I X="PHX" S Y=247
I X="POR" S Y=248
I X="TUC" S Y=249
Q Y
PTEMP ;----- PRINT TEMPLATES TO BE COMPILED
;;ACR BPA^9002196
;;ACR EQUIPMENT CERTIFICATION^9002196
;;ACR ORDER FOR SUP HEAD^9002196
;;ACR ORDER FOR SUP/SER^9002196
;;ACR PURCHASE ORDER AMENDMENT^9002196
;;ACR PURCHASE ORDER HEAD^9002196
;;ACR PURCHASE ORDER INFO^9002196
;;ACR PURCHASE ORDER INFO HEAD^9002196
;;ACR RECEIVING REPORT^9002196
;;ACR RECEIVING REPORT HEAD^9002196
;;ACR REQUEST FOR QUOTATION-H^9002196
;;ACR REQUISITION-TX^9002196
;;ACR SEPARATE TRAVEL ITINERARY^9002196
;;ACR TRAINING 350^9002196
;;ACR TRAINING EVALUATION^9002191.6
;;ACR TRAVEL ITINERARY^9002196
;;ACR TRAVEL ORDER^9002196
;;ACR TRAVEL ORDER HEAD^9002196
;;ACR TRAVEL ORDER SUMMARY^9002196
;;ACR TRAVEL VOUCHER^9002196
;;ACR TRAVEL VOUCHER SUMMARY^9002196
;;$$END
ACRF14PS ;IHS/PHXAO/AEF - ARMS PATCH 14 POST INSTALL ROUTINE [ 10/28/2004 11:08 AM ]
+1 ;;2.1;ADMINISTRATIVE RESOURCE MGMT SYSTEM;**14**;MAY 27, 2004
+2 ;
EN ;EP -- MAIN ENTRY POINT
+1 ;
+2 DO ^XBKVAR
+3 DO HOME^%ZIS
+4 DO COMPP
+5 DO COMPC
+6 DO POPCLC
+7 QUIT
COMPP ;----- RECOMPILE PRINT TEMPLATES
+1 ;
+2 NEW ACRPTEMP,I,X
+3 ;
+4 DO BMES^XPDUTL("Recompiling print templates...")
+5 ;
+6 FOR I=1:1
SET X=$TEXT(PTEMP+I)
IF X["$$END"
QUIT
SET ACRPTEMP($PIECE(X,";;",2))=""
+7 ;
+8 SET ACRPTEMP=""
+9 FOR
SET ACRPTEMP=$ORDER(ACRPTEMP(ACRPTEMP))
IF ACRPTEMP']""
QUIT
Begin DoDot:1
+10 DO ONEP(ACRPTEMP)
End DoDot:1
+11 QUIT
ONEP(ACRPTEMP) ;
+1 ;----- RECOMPILE ONE PRINT TEMPLATE
+2 ;
+3 ; ACRPTEMP = PRINT TEMPLATE NAME
+4 ;
+5 NEW ACRFILE,ACRIEN,DMAX,X,Y
+6 ;
+7 SET ACRFILE=$PIECE(ACRPTEMP,U,2)
+8 SET ACRPTEMP=$PIECE(ACRPTEMP,U)
+9 SET ACRIEN=0
+10 FOR
SET ACRIEN=$ORDER(^DIPT("B",ACRPTEMP,ACRIEN))
IF 'ACRIEN
QUIT
Begin DoDot:1
+11 IF $PIECE($GET(^DIPT(ACRIEN,0)),U,4)'=ACRFILE
QUIT
+12 SET X=$PIECE($GET(^DIPT(ACRIEN,"ROU")),U,2)
+13 IF X']""
QUIT
+14 SET Y=ACRIEN
+15 SET DMAX=$$ROUSIZE^DILF
+16 DO EN^DIPZ
End DoDot:1
+17 QUIT
COMPC ;----- COMPILE CROSSREFERENCES
+1 ;
+2 NEW DMAX,X,Y
+3 ;
+4 SET Y=9002196
+5 SET X=$GET(^DD(Y,0,"DIK"))
+6 IF X']""
QUIT
+7 SET DMAX=$$ROUSIZE^DILF
+8 DO EN^DIKZ
+9 QUIT
POPCLC ;----- POPULATE CONTRACT LOCATION CODE AND TURN ON EXPANDED DOCUMENT
+1 ; NUMBER PRINTING
+2 ;
+3 NEW ACRCLC,DA,DIE,DR,X,Y
+4 ;
+5 DO BMES^XPDUTL("Entering Contract Location Code...")
+6 DO BMES^XPDUTL("Turning on Expanded Document Number printing...")
+7 ;
+8 SET ACRCLC=$$CLC($$HOST)
+9 IF 'ACRCLC
Begin DoDot:1
+10 DO BMES^XPDUTL(">>> Cannot find Contract Location Code")
+11 DO BMES^XPDUTL(">>> Cannot turn on Expanded Document Number printing")
+12 DO BMES^XPDUTL(">>> Please update FMS System Defaults file manually")
End DoDot:1
QUIT
+13 ;
+14 SET DIE="^ACRSYS("
+15 SET DA=1
+16 SET DR="601.1///^S X=ACRCLC;601.2////^S X=1"
+17 DO ^DIE
+18 ;
+19 QUIT
HOST() ;----- RETURNS HOST NAME FROM RPMS SITE FILE
+1 ;
+2 NEW Y
+3 SET Y=""
+4 SET Y=$PIECE($GET(^AUTTSITE(1,0)),U,14)
+5 SET Y=$TRANSLATE(Y,"-")
+6 QUIT Y
CLC(X) ;----- RETURNS CONTRACT LOCATION CODE
+1 ;
+2 ; X = AREA HOST NAME
+3 ;
+4 NEW Y
+5 SET Y=""
+6 SET X=$EXTRACT(X,1,3)
+7 XECUTE ^%ZOSF("UPPERCASE")
+8 SET X=Y
+9 SET Y=""
+10 IF X="ABR"
SET Y=241
+11 IF X="AKA"
SET Y=243
+12 IF X="ALB"
SET Y=242
+13 IF X="BIL"
SET Y=244
+14 IF X="BJI"
SET Y=239
+15 IF X="CAO"
SET Y=235
+16 IF X="CMB"
SET Y=242
+17 IF X="DPS"
SET Y=236
+18 IF X="NAV"
SET Y=245
+19 IF X="NSA"
SET Y=285
+20 IF X="OKC"
SET Y=246
+21 IF X="PHX"
SET Y=247
+22 IF X="POR"
SET Y=248
+23 IF X="TUC"
SET Y=249
+24 QUIT Y
PTEMP ;----- PRINT TEMPLATES TO BE COMPILED
+1 ;;ACR BPA^9002196
+2 ;;ACR EQUIPMENT CERTIFICATION^9002196
+3 ;;ACR ORDER FOR SUP HEAD^9002196
+4 ;;ACR ORDER FOR SUP/SER^9002196
+5 ;;ACR PURCHASE ORDER AMENDMENT^9002196
+6 ;;ACR PURCHASE ORDER HEAD^9002196
+7 ;;ACR PURCHASE ORDER INFO^9002196
+8 ;;ACR PURCHASE ORDER INFO HEAD^9002196
+9 ;;ACR RECEIVING REPORT^9002196
+10 ;;ACR RECEIVING REPORT HEAD^9002196
+11 ;;ACR REQUEST FOR QUOTATION-H^9002196
+12 ;;ACR REQUISITION-TX^9002196
+13 ;;ACR SEPARATE TRAVEL ITINERARY^9002196
+14 ;;ACR TRAINING 350^9002196
+15 ;;ACR TRAINING EVALUATION^9002191.6
+16 ;;ACR TRAVEL ITINERARY^9002196
+17 ;;ACR TRAVEL ORDER^9002196
+18 ;;ACR TRAVEL ORDER HEAD^9002196
+19 ;;ACR TRAVEL ORDER SUMMARY^9002196
+20 ;;ACR TRAVEL VOUCHER^9002196
+21 ;;ACR TRAVEL VOUCHER SUMMARY^9002196
+22 ;;$$END
