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

ACMPOST.m

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