ACRF22PS ;IHS/OIRM/DSD/AEF - ARMS PATCH 22 POST INSTALL ROUTINE [ 04/02/2007 11:08 AM ]
;;2.1;ADMINISTRATIVE RESOURCE MGMT SYSTEM;**22**;MAY 27, 2004
;
EN ;EP -- MAIN ENTRY POINT --
;
D ^XBKVAR
D HOME^%ZIS
D COMPP ;USE TO RECOMPILE PRINT TEMPLATES
D ADDMENU ;USE TO ADD NEW MENU OPTIONS
D OPT ;ADD KEY TO NEW MENU OPTION
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
;
;SUBSCRIPTS FOR ADD^XPDMENU UTILITY:
; 1) MENU NAME TO RECEIVE NEW OPTION
; 2) OPTION NAME TO PUT ON MENU
; 3) SYNONYM TO DISPLAY FOR NEW OPTION
; IF THE SYNONYM IS NOT PASSED, THE OPTION WILL USE THE SYNONYM THAT WAS
; ORIGINALLY ESTABLISHED ON THE SENDING SYSTEM
;
;***** MENU OPTION TO ADD *****
;
NEW HEREYAGO
D BMES^XPDUTL("Adding ACRF UFMS READINESS REPORTS to ACRF M VENDOR MENU.")
S HEREYAGO=$$ADD^XPDMENU("ACRF M VENDOR MENU","ACRF UFMS READINESS REPORTS","URR")
;
I HEREYAGO=1 D
. D OKAY("ACRF UFMS READINESS REPORTS added to ACRF M VENDOR MENU.")
;
I HEREYAGO'=1 D
.S HEREYAGO=$P($$UP^XLFSTR(HEREYAGO),"^",2) ; Uppercase Error Message
.D TABMENU("Error in adding ACRF UFMS READINESS REPORTS to ACRF M VENDOR MENU.")
.I $L(HEREYAGO)>0 D TABMENU("Error Message: "_$P(HERYAGO,"^",2),10)
;
;***** ADDITIONAL MENU OPTION TO ADD *****
;
NEW HEREYAGO
D BMES^XPDUTL("Adding ACRF UFMS CORE OPEN DOC RPTS to ACRF M VENDOR MENU.")
S HEREYAGO=$$ADD^XPDMENU("ACRF M VENDOR MENU","ACRF UFMS CORE OPEN DOC RPTS","OD")
;
I HEREYAGO=1 D
. D OKAY("ACRF UFMS CORE OPEN DOC RPTS added to ACRF M VENDOR MENU.")
;
I HEREYAGO'=1 D
.S HEREYAGO=$P($$UP^XLFSTR(HEREYAGO),"^",2) ; Uppercase Error Message
.D TABMENU("Error in adding ACRF UFMS CORE OPEN DOC RPTS to ACRF M VENDOR MENU.")
.I $L(HEREYAGO)>0 D TABMENU("Error Message: "_$P(HERYAGO,"^",2),10)
;
;***** ADDITIONAL MENU OPTION TO ADD *****
;
NEW HEREYAGO
D BMES^XPDUTL("Adding ACRF M VENDOR MENU to ACRMENU.")
S HEREYAGO=$$ADD^XPDMENU("ACRMENU","ACRF M VENDOR MENU","VM")
;
I HEREYAGO=1 D
. D OKAY("ACRF M VENDOR MENU added to ACRMENU.")
;
I HEREYAGO'=1 D
.S HEREYAGO=$P($$UP^XLFSTR(HEREYAGO),"^",2) ; Uppercase Error Message
.D TABMENU("Error in adding ACRF M VENDOR MENU to ACRMENU.")
.I $L(HEREYAGO)>0 D TABMENU("Error Message: "_$P(HERYAGO,"^",2),10)
Q
OKAY(MSG,TAB) ;
; MESSAGE WITH "OK" AT THE END
NEW MESSAGE
I $G(TAB)="" S TAB=5
S MESSAGE=$J("",TAB)_MSG_" OK."
D MES^XPDUTL(MESSAGE)
Q
; GENERIC MESSAGE OUTPUT
NEW MESSAGE
I $G(TAB)="" S TAB=5
S MESSAGE=$J("",TAB)_MSG
I $G(TAIL)'="" S MESSAGE=MESSAGE_" "_TAIL
D MES^XPDUTL(MESSAGE)
Q
OPT ;----- ADD KEY TO OPTION
;
;
N DIC,X,Y
S DIC="^DIC(19,"
S DIC(0)=""
S X="ACRF M VENDOR MENU"
D ^DIC
Q:+Y'>0
D BMES^XPDUTL("Adding Vendor Menu key ACRZ VENDOR to Vendor Menu option")
S DA=+Y
S DIE=DIC
S DR="3///^S X=""ACRZ VENDOR"""
D ^DIE
Q
;
PTEMP ;----- PRINT TEMPLATES TO BE COMPILED
;;ACR CREDIT CARD VENDOR^9999999.11
;;$$END
ACRF22PS ;IHS/OIRM/DSD/AEF - ARMS PATCH 22 POST INSTALL ROUTINE [ 04/02/2007 11:08 AM ]
+1 ;;2.1;ADMINISTRATIVE RESOURCE MGMT SYSTEM;**22**;MAY 27, 2004
+2 ;
EN ;EP -- MAIN ENTRY POINT --
+1 ;
+2 DO ^XBKVAR
+3 DO HOME^%ZIS
+4 ;USE TO RECOMPILE PRINT TEMPLATES
DO COMPP
+5 ;USE TO ADD NEW MENU OPTIONS
DO ADDMENU
+6 ;ADD KEY TO NEW MENU OPTION
DO OPT
+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
+1 ;
+2 ;SUBSCRIPTS FOR ADD^XPDMENU UTILITY:
+3 ; 1) MENU NAME TO RECEIVE NEW OPTION
+4 ; 2) OPTION NAME TO PUT ON MENU
+5 ; 3) SYNONYM TO DISPLAY FOR NEW OPTION
+6 ; IF THE SYNONYM IS NOT PASSED, THE OPTION WILL USE THE SYNONYM THAT WAS
+7 ; ORIGINALLY ESTABLISHED ON THE SENDING SYSTEM
+8 ;
+9 ;***** MENU OPTION TO ADD *****
+10 ;
+11 NEW HEREYAGO
+12 DO BMES^XPDUTL("Adding ACRF UFMS READINESS REPORTS to ACRF M VENDOR MENU.")
+13 SET HEREYAGO=$$ADD^XPDMENU("ACRF M VENDOR MENU","ACRF UFMS READINESS REPORTS","URR")
+14 ;
+15 IF HEREYAGO=1
Begin DoDot:1
+16 DO OKAY("ACRF UFMS READINESS REPORTS added to ACRF M VENDOR MENU.")
End DoDot:1
+17 ;
+18 IF HEREYAGO'=1
Begin DoDot:1
+19 ; Uppercase Error Message
SET HEREYAGO=$PIECE($$UP^XLFSTR(HEREYAGO),"^",2)
+20 DO TABMENU("Error in adding ACRF UFMS READINESS REPORTS to ACRF M VENDOR MENU.")
+21 IF $LENGTH(HEREYAGO)>0
DO TABMENU("Error Message: "_$PIECE(HERYAGO,"^",2),10)
End DoDot:1
+22 ;
+23 ;***** ADDITIONAL MENU OPTION TO ADD *****
+24 ;
+25 NEW HEREYAGO
+26 DO BMES^XPDUTL("Adding ACRF UFMS CORE OPEN DOC RPTS to ACRF M VENDOR MENU.")
+27 SET HEREYAGO=$$ADD^XPDMENU("ACRF M VENDOR MENU","ACRF UFMS CORE OPEN DOC RPTS","OD")
+28 ;
+29 IF HEREYAGO=1
Begin DoDot:1
+30 DO OKAY("ACRF UFMS CORE OPEN DOC RPTS added to ACRF M VENDOR MENU.")
End DoDot:1
+31 ;
+32 IF HEREYAGO'=1
Begin DoDot:1
+33 ; Uppercase Error Message
SET HEREYAGO=$PIECE($$UP^XLFSTR(HEREYAGO),"^",2)
+34 DO TABMENU("Error in adding ACRF UFMS CORE OPEN DOC RPTS to ACRF M VENDOR MENU.")
+35 IF $LENGTH(HEREYAGO)>0
DO TABMENU("Error Message: "_$PIECE(HERYAGO,"^",2),10)
End DoDot:1
+36 ;
+37 ;***** ADDITIONAL MENU OPTION TO ADD *****
+38 ;
+39 NEW HEREYAGO
+40 DO BMES^XPDUTL("Adding ACRF M VENDOR MENU to ACRMENU.")
+41 SET HEREYAGO=$$ADD^XPDMENU("ACRMENU","ACRF M VENDOR MENU","VM")
+42 ;
+43 IF HEREYAGO=1
Begin DoDot:1
+44 DO OKAY("ACRF M VENDOR MENU added to ACRMENU.")
End DoDot:1
+45 ;
+46 IF HEREYAGO'=1
Begin DoDot:1
+47 ; Uppercase Error Message
SET HEREYAGO=$PIECE($$UP^XLFSTR(HEREYAGO),"^",2)
+48 DO TABMENU("Error in adding ACRF M VENDOR MENU to ACRMENU.")
+49 IF $LENGTH(HEREYAGO)>0
DO TABMENU("Error Message: "_$PIECE(HERYAGO,"^",2),10)
End DoDot:1
+50 QUIT
OKAY(MSG,TAB) ;
+1 ; MESSAGE WITH "OK" AT THE END
+2 NEW MESSAGE
+3 IF $GET(TAB)=""
SET TAB=5
+4 SET MESSAGE=$JUSTIFY("",TAB)_MSG_" OK."
+5 DO MES^XPDUTL(MESSAGE)
+6 QUIT
+1 ; GENERIC MESSAGE OUTPUT
+2 NEW MESSAGE
+3 IF $GET(TAB)=""
SET TAB=5
+4 SET MESSAGE=$JUSTIFY("",TAB)_MSG
+5 IF $GET(TAIL)'=""
SET MESSAGE=MESSAGE_" "_TAIL
+6 DO MES^XPDUTL(MESSAGE)
+7 QUIT
OPT ;----- ADD KEY TO OPTION
+1 ;
+2 ;
+3 NEW DIC,X,Y
+4 SET DIC="^DIC(19,"
+5 SET DIC(0)=""
+6 SET X="ACRF M VENDOR MENU"
+7 DO ^DIC
+8 IF +Y'>0
QUIT
+9 DO BMES^XPDUTL("Adding Vendor Menu key ACRZ VENDOR to Vendor Menu option")
+10 SET DA=+Y
+11 SET DIE=DIC
+12 SET DR="3///^S X=""ACRZ VENDOR"""
+13 DO ^DIE
+14 QUIT
+15 ;
PTEMP ;----- PRINT TEMPLATES TO BE COMPILED
+1 ;;ACR CREDIT CARD VENDOR^9999999.11
+2 ;;$$END
