Routine: ACRF22PS

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

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)

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

ADDMENU ; ADD AN OPTION TO A MENU

 ;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)

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)

TABMENU(MSG,TAB,TAIL) ;

 ; 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)

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

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

ADDMENU   ; ADD AN OPTION TO A MENU

 +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

TABMENU(MSG,TAB,TAIL) ;

 +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

ACRF22PS.m