ACMPOST ;cmi/anch/maw - CONTROLLER FOR CMS ; [ 02/10/2009 9:51 AM ]
;;2.0;ACM CASE MANAGEMENT SYSTEM;**6,7,8**;JAN 10, 1996
;;NO POST INIT ACTION FOR THIS VERSION (1.61)
;Q
;
ENV ;EP;IHS/CMI/TMJ PATCH 8
; The following line prevents the "Disable Options..." and "Move
; Routines..." questions from being asked during the install.
F X="XPM1","XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
I $$INSTALLD("ACM*2.00*7") Q
I $$INSTALLD("ACM*2.0*7") Q
D SORRY(2)
Q
;
EN D ^ACMTMPI
W !!,"All CMS SORT File Associated Print Templates Repointed",!
D EN1
W !!,"All Re-Index of All Cross Reference Completed",!
D CONVRES
W !!,"Restrict Field Conversion Complete",!!
D CONV200
W !,"File 200 Conversion Complete",!
D CONVRCL
W !!,"Recall Letter Conversion Complete",!!
;
D EXIT
;
D PRTUSER
Q
;
CONVRES ;
;Convert Restricted field to HEALTH SUMMARY field , flip flop data
;CHANGE 0 TO 1 AND 1 TO 0
S X=0 F S X=$O(^ACM(41.1,X)) Q:X'=+X D
.I $P(^ACM(41.1,X,0),U,7)=1 S $P(^ACM(41.1,X,0),U,7)=0 Q
.I '$P(^ACM(41.1,X,0),U,7) S $P(^ACM(41.1,X,0),U,7)=1
.Q
Q
EN1 W !,"THE 'NAME OF REGISTER' CROSS REFERENCE WILL NOW BE SET.",!,"THIS MAY TAKE SEVERAL MINUTES. DO NOT INTERRUPT."
F ACM=41:1:49,51,53,54,57 S DIK="^ACM("_ACM_",",DIK(1)=$S(ACM'=41:".04^1",1:".01^2") D ENALL^DIK
K DIK,DR,DA
Q
;
;
CONV200 ;Convert File 200 Entry Point
I '$D(^ACM(40,DUZ(2))) D V200FACD,V200FAC I '$D(^ACM(40,DUZ(2))) W !!,"Unable to create Facility Entry in CMS Parameters File",! Q
I $P(^ACM(40,DUZ(2),0),U,2) W !,"CONVERSION DONE PREVIOUSLY",! Q
W !!!,*7
W "It appears you have not upgraded the Case Management System to recognize",!
W "File 200 - the",!,"***NEW PERSON FILE ***",!!
W "Let's do the upgrade now!",!
D V200CONV,V200DIE
;
Q
;
;
;
V200FACD ;Delete Existing Non-DINUM entries CMS Parameters
;
;K ^UTILITY("XBDSET",$J)
;S ^UTILITY("XBDSET",$J,"9002240")="" D EN2^XBFRESET
;W !!,"The Non-DINUM entries have been deleted from the CMS Paramaters File",!!
Q
;
V200FAC ;Adds Facility to CMS PARAMETERS File if non-existent
S X="`"_DUZ(2),DLAYGO=9002240,DIADD=1,DIC(0)="L",DIC="^ACM(40," D ^DIC
I Y=-1 W !!,"Error has ocurred..Cannot Add a Facility to the CMS Parameters File - Call Developer On This Error!!!"
Q
V200DIE ;SET FLAG IN CMS PARAMETERS FILE TO INDICATE FILE 200 CONVERSION
W !!,"I will now set CMS Parameters Flag to Indicate File 200 Conversion has been completed",!!
S DIE="^ACM(40,",DA=DUZ(2),DR="3///1" D ^DIE K DIE,DR,DA,DIC
Q
;
V200CONV ;File 200 Conversion
W "I will now begin the Conversion Process",!
S ACMDFN=0 F S ACMDFN=$O(^ACM(41,ACMDFN)) Q:ACMDFN'=+ACMDFN I $D(^ACM(41,ACMDFN,"DT")) D
.D CASEMGR
.D PHN
.D PROV
.Q
Q
CASEMGR ;CASE MANAGER FIX
;Convert 6th piece - Case Manager
S ACMOLDN=$P(^ACM(41,ACMDFN,"DT"),U,6)
Q:'ACMOLDN
S ACMNEWN=$G(^DIC(16,ACMOLDN,"A3"))
I 'ACMNEWN W !!,"ERROR - ERROR in Case Manager Record "_ACMDFN,! Q
S DA=ACMDFN,DIE="^ACM(41,",DR="6////"_ACMNEWN D ^DIE K DIE
Q
PHN ;PHN FIX
;Convert 7th piece - PHN
S ACMOLDN=$P(^ACM(41,ACMDFN,"DT"),U,7)
Q:'ACMOLDN
S ACMNEWN=$G(^DIC(16,ACMOLDN,"A3"))
I 'ACMNEWN W !!,"ERROR - ERROR in PHN Record "_ACMDFN,! Q
S DA=ACMDFN,DIE="^ACM(41,",DR="7////"_ACMNEWN D ^DIE K DIE
Q
PROV ;PRIMARY PROVIDER FIX
;Convert 15th piece - PRIMARY PROVIDER
S ACMOLDN=$P(^ACM(41,ACMDFN,"DT"),U,15)
Q:'ACMOLDN
S ACMNEWN=$G(^DIC(16,ACMOLDN,"A3"))
I 'ACMNEWN W !!,"ERROR - ERROR in Provider Record "_ACMDFN,! Q
S DA=ACMDFN,DIE="^ACM(41,",DR="15////"_ACMNEWN D ^DIE K DIE
Q
;
;
;
CONVRCL ;Convert Call Letters
D ^ACMPOST1
Q
;
DELCMSL ;-- this subroutine will delete entries in the CMS LISTER ITEMS file before installing new ones
N ACMDA
S ACMDA=0 F S ACMDA=$O(^ACM(58.1,ACMDA)) Q:'ACMDA D
. S DIK="^ACM(58.1,",DA=ACMDA
. D ^DIK
Q
;
PRTUSER ;Print Register Developer and Users
;
W !!!,?5,"**********************************************************************",!
W !,?10,"YOU MAY NOW PRINT THE EXISTING REGISTER DEVELOPER",! W ?10,"AND ASSOCIATED AUTHORIZED USERS...",!
W !!,?5,"Improved Register Security has been addressed by adding a new field",!
W ?5,"to the CMS Register Type file name REGISTER CREATOR. ONLY the CREATOR",!
W ?5,"of the Register may modify the existing Register Structure, or",!
W ?5,"assign Authorized Users to that Register, or Delete that Register.",!
W ?5,"Utilizing FileMan, one CREATOR for each existing Register must be entered.",!
W ?5,"Once you have printed the following list of existing Register Developers",!
W ?5,"and Authorized Users, refer to the Install Notes on how to add the",!
W ?5,"REGISTER CREATOR to the CMS Register Type file.",!!
W ?5,"**********************************************************************",!!
S DIC="^ACM(41.1,",FLDS="[ACM REGISTER DEVELOPER]",BY="@REGISTER TYPE",FR="A",TO="ZZ" D DIP
;
Q
DIP ;
D EN1^DIP Q
EXIT ;
W !!!,?10,"ALL POST INIT CONVERSIONS HAVE BEEN SUCCESSFULLY COMPLETED!!",!
W ?32,"INSTALL NOW DONE!!",!
K ACMDFN,ACMOLDN,ACMNEWN
Q
44 ;EP;TO ADD THE 'AC' CROSS REFERENCE AND REINDEX ALL CMS PATIENT FILES
;IHS/CIM/THL PATCH 2
W:'$D(ZTQUEUED) !!,"This could take several minutes. Please stand by.",!!
N XX1,XX2,X
F XX1=42:1:49,51:1:54,57 D
.S XX2=9002200+XX1
.Q:'$D(^DD(XX2,.01,1))
.F X="AC","B","C","D","E","F" K ^ACM(XX1,X)
.S DIK="^ACM("_XX1_","
.D IXALL^DIK
.W:'$D(ZTQUEUED) !,XX1 ;"."
Q
;
POST6 ;EP;FOR PATCH 6
F ACMX="ACM INSTALL PRE DM" D
.S ACMY="PDM"
.S X=$$ADD^XPDMENU("ACMMENU",ACMX,ACMY)
;
D ^ACMBUL6
Q
;
PRE6 ;EP;FOR PATCH 6 PRE-INIT
;Kill of Lister Items
F DA=1:1:900 S DIK="^ACM(58.1," D ^DIK
;now delete dd fields that have trigger with $N
S DIK="^DD(9002241,",DA=.01,DA(1)=9002241 D ^DIK
S DIK="^DD(9002242,",DA=.04,DA(1)=9002242 D ^DIK
S DIK="^DD(9002243,",DA=.04,DA(1)=9002243 D ^DIK
S DIK="^DD(9002244,",DA=.04,DA(1)=9002244 D ^DIK
S DIK="^DD(9002245,",DA=.04,DA(1)=9002245 D ^DIK
S DIK="^DD(9002246,",DA=.04,DA(1)=9002246 D ^DIK
S DIK="^DD(9002247,",DA=.04,DA(1)=9002247 D ^DIK
S DIK="^DD(9002248,",DA=.04,DA(1)=9002248 D ^DIK
S DIK="^DD(9002249,",DA=.04,DA(1)=9002249 D ^DIK
S DIK="^DD(9002251,",DA=.04,DA(1)=9002251 D ^DIK
S DIK="^DD(9002253,",DA=.04,DA(1)=9002253 D ^DIK
S DIK="^DD(9002254,",DA=.04,DA(1)=9002254 D ^DIK
S DIK="^DD(9002257,",DA=.04,DA(1)=9002257 D ^DIK
S DIK="^DD(9002258.8,",DA=.07,DA(1)=9002258.8 D ^DIK
Q
;
P7 ;-- patch 7 post init
D OPT7
D ^ACMBUL7
Q
;
OPT7 ;-- add patch 7 options
N ACMX,ACMY
F ACMX="ACM E DISP/EDIT REG CREATOR" D
.S ACMY="ECR"
.S X=$$ADD^XPDMENU("ACMMENU",ACMX,ACMY)
F ACMX="APCLLT CUSTOM LETTER MGT" D
.S ACMY="CLM"
.S X=$$ADD^XPDMENU("ACMMENU",ACMX,ACMY)
Q
;
P8 ;EP - post init patch 8
D ADD^XPDMENU("ACMMENU","APCLLT CUSTOM LETTER MGT","CLM",50)
D ADD^XPDMENU("ACMMENU","AMQQMENU","QMAN",30)
Q
INSTALLD(ACMSTAL) ;EP - Determine if patch ACMSTAL was installed, where
; ACMSTAL is the name of the INSTALL. E.g "AG*6.0*11".
NEW ACMY,DIC,X,Y
S X=$P(ACMSTAL,"*",1)
S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
D IX^DIC
I Y<1 D IMES Q 0
S DIC=DIC_+Y_",22,",X=$P(ACMSTAL,"*",2)
D ^DIC
I Y<1 D IMES Q 0
S DIC=DIC_+Y_",""PAH"",",X=$P(ACMSTAL,"*",3)
D ^DIC
S ACMY=Y
D IMES
Q $S(ACMY<1:0,1:1)
IMES ;
D MES^XPDUTL($$CJ^XLFSTR("Patch """_ACMSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" installed.",IOM))
Q
SORRY(X) ;
KILL DIFQ
I X=3 S XPDQUIT=2 Q
S XPDQUIT=X
W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
Q
ACMPOST ;cmi/anch/maw - CONTROLLER FOR CMS ; [ 02/10/2009 9:51 AM ]
+1 ;;2.0;ACM CASE MANAGEMENT SYSTEM;**6,7,8**;JAN 10, 1996
+2 ;;NO POST INIT ACTION FOR THIS VERSION (1.61)
+3 ;Q
+4 ;
ENV ;EP;IHS/CMI/TMJ PATCH 8
+1 ; The following line prevents the "Disable Options..." and "Move
+2 ; Routines..." questions from being asked during the install.
+3 FOR X="XPM1","XPO1","XPZ1","XPZ2","XPI1"
SET XPDDIQ(X)=0
+4 IF $$INSTALLD("ACM*2.00*7")
QUIT
+5 IF $$INSTALLD("ACM*2.0*7")
QUIT
+6 DO SORRY(2)
+7 QUIT
+8 ;
EN DO ^ACMTMPI
+1 WRITE !!,"All CMS SORT File Associated Print Templates Repointed",!
+2 DO EN1
+3 WRITE !!,"All Re-Index of All Cross Reference Completed",!
+4 DO CONVRES
+5 WRITE !!,"Restrict Field Conversion Complete",!!
+6 DO CONV200
+7 WRITE !,"File 200 Conversion Complete",!
+8 DO CONVRCL
+9 WRITE !!,"Recall Letter Conversion Complete",!!
+10 ;
+11 DO EXIT
+12 ;
+13 DO PRTUSER
+14 QUIT
+15 ;
CONVRES ;
+1 ;Convert Restricted field to HEALTH SUMMARY field , flip flop data
+2 ;CHANGE 0 TO 1 AND 1 TO 0
+3 SET X=0
FOR
SET X=$ORDER(^ACM(41.1,X))
IF X'=+X
QUIT
Begin DoDot:1
+4 IF $PIECE(^ACM(41.1,X,0),U,7)=1
SET $PIECE(^ACM(41.1,X,0),U,7)=0
QUIT
+5 IF '$PIECE(^ACM(41.1,X,0),U,7)
SET $PIECE(^ACM(41.1,X,0),U,7)=1
+6 QUIT
End DoDot:1
+7 QUIT
EN1 WRITE !,"THE 'NAME OF REGISTER' CROSS REFERENCE WILL NOW BE SET.",!,"THIS MAY TAKE SEVERAL MINUTES. DO NOT INTERRUPT."
+1 FOR ACM=41:1:49,51,53,54,57
SET DIK="^ACM("_ACM_","
SET DIK(1)=$SELECT(ACM'=41:".04^1",1:".01^2")
DO ENALL^DIK
+2 KILL DIK,DR,DA
+3 QUIT
+4 ;
+5 ;
CONV200 ;Convert File 200 Entry Point
+1 IF '$DATA(^ACM(40,DUZ(2)))
DO V200FACD
DO V200FAC
IF '$DATA(^ACM(40,DUZ(2)))
WRITE !!,"Unable to create Facility Entry in CMS Parameters File",!
QUIT
+2 IF $PIECE(^ACM(40,DUZ(2),0),U,2)
WRITE !,"CONVERSION DONE PREVIOUSLY",!
QUIT
+3 WRITE !!!,*7
+4 WRITE "It appears you have not upgraded the Case Management System to recognize",!
+5 WRITE "File 200 - the",!,"***NEW PERSON FILE ***",!!
+6 WRITE "Let's do the upgrade now!",!
+7 DO V200CONV
DO V200DIE
+8 ;
+9 QUIT
+10 ;
+11 ;
+12 ;
V200FACD ;Delete Existing Non-DINUM entries CMS Parameters
+1 ;
+2 ;K ^UTILITY("XBDSET",$J)
+3 ;S ^UTILITY("XBDSET",$J,"9002240")="" D EN2^XBFRESET
+4 ;W !!,"The Non-DINUM entries have been deleted from the CMS Paramaters File",!!
+5 QUIT
+6 ;
V200FAC ;Adds Facility to CMS PARAMETERS File if non-existent
+1 SET X="`"_DUZ(2)
SET DLAYGO=9002240
SET DIADD=1
SET DIC(0)="L"
SET DIC="^ACM(40,"
DO ^DIC
+2 IF Y=-1
WRITE !!,"Error has ocurred..Cannot Add a Facility to the CMS Parameters File - Call Developer On This Error!!!"
+3 QUIT
V200DIE ;SET FLAG IN CMS PARAMETERS FILE TO INDICATE FILE 200 CONVERSION
+1 WRITE !!,"I will now set CMS Parameters Flag to Indicate File 200 Conversion has been completed",!!
+2 SET DIE="^ACM(40,"
SET DA=DUZ(2)
SET DR="3///1"
DO ^DIE
KILL DIE,DR,DA,DIC
+3 QUIT
+4 ;
V200CONV ;File 200 Conversion
+1 WRITE "I will now begin the Conversion Process",!
+2 SET ACMDFN=0
FOR
SET ACMDFN=$ORDER(^ACM(41,ACMDFN))
IF ACMDFN'=+ACMDFN
QUIT
IF $DATA(^ACM(41,ACMDFN,"DT"))
Begin DoDot:1
+3 DO CASEMGR
+4 DO PHN
+5 DO PROV
+6 QUIT
End DoDot:1
+7 QUIT
CASEMGR ;CASE MANAGER FIX
+1 ;Convert 6th piece - Case Manager
+2 SET ACMOLDN=$PIECE(^ACM(41,ACMDFN,"DT"),U,6)
+3 IF 'ACMOLDN
QUIT
+4 SET ACMNEWN=$GET(^DIC(16,ACMOLDN,"A3"))
+5 IF 'ACMNEWN
WRITE !!,"ERROR - ERROR in Case Manager Record "_ACMDFN,!
QUIT
+6 SET DA=ACMDFN
SET DIE="^ACM(41,"
SET DR="6////"_ACMNEWN
DO ^DIE
KILL DIE
+7 QUIT
PHN ;PHN FIX
+1 ;Convert 7th piece - PHN
+2 SET ACMOLDN=$PIECE(^ACM(41,ACMDFN,"DT"),U,7)
+3 IF 'ACMOLDN
QUIT
+4 SET ACMNEWN=$GET(^DIC(16,ACMOLDN,"A3"))
+5 IF 'ACMNEWN
WRITE !!,"ERROR - ERROR in PHN Record "_ACMDFN,!
QUIT
+6 SET DA=ACMDFN
SET DIE="^ACM(41,"
SET DR="7////"_ACMNEWN
DO ^DIE
KILL DIE
+7 QUIT
PROV ;PRIMARY PROVIDER FIX
+1 ;Convert 15th piece - PRIMARY PROVIDER
+2 SET ACMOLDN=$PIECE(^ACM(41,ACMDFN,"DT"),U,15)
+3 IF 'ACMOLDN
QUIT
+4 SET ACMNEWN=$GET(^DIC(16,ACMOLDN,"A3"))
+5 IF 'ACMNEWN
WRITE !!,"ERROR - ERROR in Provider Record "_ACMDFN,!
QUIT
+6 SET DA=ACMDFN
SET DIE="^ACM(41,"
SET DR="15////"_ACMNEWN
DO ^DIE
KILL DIE
+7 QUIT
+8 ;
+9 ;
+10 ;
CONVRCL ;Convert Call Letters
+1 DO ^ACMPOST1
+2 QUIT
+3 ;
DELCMSL ;-- this subroutine will delete entries in the CMS LISTER ITEMS file before installing new ones
+1 NEW ACMDA
+2 SET ACMDA=0
FOR
SET ACMDA=$ORDER(^ACM(58.1,ACMDA))
IF 'ACMDA
QUIT
Begin DoDot:1
+3 SET DIK="^ACM(58.1,"
SET DA=ACMDA
+4 DO ^DIK
End DoDot:1
+5 QUIT
+6 ;
PRTUSER ;Print Register Developer and Users
+1 ;
+2 WRITE !!!,?5,"**********************************************************************",!
+3 WRITE !,?10,"YOU MAY NOW PRINT THE EXISTING REGISTER DEVELOPER",!
WRITE ?10,"AND ASSOCIATED AUTHORIZED USERS...",!
+4 WRITE !!,?5,"Improved Register Security has been addressed by adding a new field",!
+5 WRITE ?5,"to the CMS Register Type file name REGISTER CREATOR. ONLY the CREATOR",!
+6 WRITE ?5,"of the Register may modify the existing Register Structure, or",!
+7 WRITE ?5,"assign Authorized Users to that Register, or Delete that Register.",!
+8 WRITE ?5,"Utilizing FileMan, one CREATOR for each existing Register must be entered.",!
+9 WRITE ?5,"Once you have printed the following list of existing Register Developers",!
+10 WRITE ?5,"and Authorized Users, refer to the Install Notes on how to add the",!
+11 WRITE ?5,"REGISTER CREATOR to the CMS Register Type file.",!!
+12 WRITE ?5,"**********************************************************************",!!
+13 SET DIC="^ACM(41.1,"
SET FLDS="[ACM REGISTER DEVELOPER]"
SET BY="@REGISTER TYPE"
SET FR="A"
SET TO="ZZ"
DO DIP
+14 ;
+15 QUIT
DIP ;
+1 DO EN1^DIP
QUIT
EXIT ;
+1 WRITE !!!,?10,"ALL POST INIT CONVERSIONS HAVE BEEN SUCCESSFULLY COMPLETED!!",!
+2 WRITE ?32,"INSTALL NOW DONE!!",!
+3 KILL ACMDFN,ACMOLDN,ACMNEWN
+4 QUIT
44 ;EP;TO ADD THE 'AC' CROSS REFERENCE AND REINDEX ALL CMS PATIENT FILES
+1 ;IHS/CIM/THL PATCH 2
+2 IF '$DATA(ZTQUEUED)
WRITE !!,"This could take several minutes. Please stand by.",!!
+3 NEW XX1,XX2,X
+4 FOR XX1=42:1:49,51:1:54,57
Begin DoDot:1
+5 SET XX2=9002200+XX1
+6 IF '$DATA(^DD(XX2,.01,1))
QUIT
+7 FOR X="AC","B","C","D","E","F"
KILL ^ACM(XX1,X)
+8 SET DIK="^ACM("_XX1_","
+9 DO IXALL^DIK
+10 ;"."
IF '$DATA(ZTQUEUED)
WRITE !,XX1
End DoDot:1
+11 QUIT
+12 ;
POST6 ;EP;FOR PATCH 6
+1 FOR ACMX="ACM INSTALL PRE DM"
Begin DoDot:1
+2 SET ACMY="PDM"
+3 SET X=$$ADD^XPDMENU("ACMMENU",ACMX,ACMY)
End DoDot:1
+4 ;
+5 DO ^ACMBUL6
+6 QUIT
+7 ;
PRE6 ;EP;FOR PATCH 6 PRE-INIT
+1 ;Kill of Lister Items
+2 FOR DA=1:1:900
SET DIK="^ACM(58.1,"
DO ^DIK
+3 ;now delete dd fields that have trigger with $N
+4 SET DIK="^DD(9002241,"
SET DA=.01
SET DA(1)=9002241
DO ^DIK
+5 SET DIK="^DD(9002242,"
SET DA=.04
SET DA(1)=9002242
DO ^DIK
+6 SET DIK="^DD(9002243,"
SET DA=.04
SET DA(1)=9002243
DO ^DIK
+7 SET DIK="^DD(9002244,"
SET DA=.04
SET DA(1)=9002244
DO ^DIK
+8 SET DIK="^DD(9002245,"
SET DA=.04
SET DA(1)=9002245
DO ^DIK
+9 SET DIK="^DD(9002246,"
SET DA=.04
SET DA(1)=9002246
DO ^DIK
+10 SET DIK="^DD(9002247,"
SET DA=.04
SET DA(1)=9002247
DO ^DIK
+11 SET DIK="^DD(9002248,"
SET DA=.04
SET DA(1)=9002248
DO ^DIK
+12 SET DIK="^DD(9002249,"
SET DA=.04
SET DA(1)=9002249
DO ^DIK
+13 SET DIK="^DD(9002251,"
SET DA=.04
SET DA(1)=9002251
DO ^DIK
+14 SET DIK="^DD(9002253,"
SET DA=.04
SET DA(1)=9002253
DO ^DIK
+15 SET DIK="^DD(9002254,"
SET DA=.04
SET DA(1)=9002254
DO ^DIK
+16 SET DIK="^DD(9002257,"
SET DA=.04
SET DA(1)=9002257
DO ^DIK
+17 SET DIK="^DD(9002258.8,"
SET DA=.07
SET DA(1)=9002258.8
DO ^DIK
+18 QUIT
+19 ;
P7 ;-- patch 7 post init
+1 DO OPT7
+2 DO ^ACMBUL7
+3 QUIT
+4 ;
OPT7 ;-- add patch 7 options
+1 NEW ACMX,ACMY
+2 FOR ACMX="ACM E DISP/EDIT REG CREATOR"
Begin DoDot:1
+3 SET ACMY="ECR"
+4 SET X=$$ADD^XPDMENU("ACMMENU",ACMX,ACMY)
End DoDot:1
+5 FOR ACMX="APCLLT CUSTOM LETTER MGT"
Begin DoDot:1
+6 SET ACMY="CLM"
+7 SET X=$$ADD^XPDMENU("ACMMENU",ACMX,ACMY)
End DoDot:1
+8 QUIT
+9 ;
P8 ;EP - post init patch 8
+1 DO ADD^XPDMENU("ACMMENU","APCLLT CUSTOM LETTER MGT","CLM",50)
+2 DO ADD^XPDMENU("ACMMENU","AMQQMENU","QMAN",30)
+3 QUIT
INSTALLD(ACMSTAL) ;EP - Determine if patch ACMSTAL was installed, where
+1 ; ACMSTAL is the name of the INSTALL. E.g "AG*6.0*11".
+2 NEW ACMY,DIC,X,Y
+3 SET X=$PIECE(ACMSTAL,"*",1)
+4 SET DIC="^DIC(9.4,"
SET DIC(0)="FM"
SET D="C"
+5 DO IX^DIC
+6 IF Y<1
DO IMES
QUIT 0
+7 SET DIC=DIC_+Y_",22,"
SET X=$PIECE(ACMSTAL,"*",2)
+8 DO ^DIC
+9 IF Y<1
DO IMES
QUIT 0
+10 SET DIC=DIC_+Y_",""PAH"","
SET X=$PIECE(ACMSTAL,"*",3)
+11 DO ^DIC
+12 SET ACMY=Y
+13 DO IMES
+14 QUIT $SELECT(ACMY<1:0,1:1)
IMES ;
+1 DO MES^XPDUTL($$CJ^XLFSTR("Patch """_ACMSTAL_""" is"_$SELECT(Y<1:" *NOT*",1:"")_" installed.",IOM))
+2 QUIT
SORRY(X) ;
+1 KILL DIFQ
+2 IF X=3
SET XPDQUIT=2
QUIT
+3 SET XPDQUIT=X
+4 WRITE *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
+5 QUIT
