GMTSPI99 ;SLC/WAT - INSTALL ROUTINES FOR HRMH GMTS COMPONENTS ;12/01/11 11:13
;;2.7;Health Summary;**99**;Oct 20, 1995;Build 45
;
;UPDATE^DIE 2053
;^DIK 10013
;FIND and $$FIND1^DIC 2051
;CLEAN^DILF 2054
;B/MES^XPDUTL, $$PATCH^XPDUTL 10141
;^PXRMEXSI 4371
;5687 - allows GMTS to transport Reminder Exchange files in KIDS build
;
; check enviro-abort if 99 already installed. if national IENs are already used or HS component name already exists, abort and advise.
N GMTSABRT
I $$PATCH^XPDUTL("GMTS*2.7*99") D BMES^XPDUTL("GMTS*2.7*99 has been previously installed. Environment check complete.") Q
D BMES^XPDUTL(" Verifying installation environment...")
D MES^XPDUTL("Checking Health Summary Component file (#142.1)")
I +$$LU(142.1,"MAS CONTACTS","X")>0!($O(^GMT(142.1,"B","MAS CONTACTS",""))=253) D
.D MES^XPDUTL(" Environment Error: NAME or IEN collision with MAS CONTACTS.") S GMTSABRT=1
;
I +$$LU(142.1,"MAS MH CLINIC VISITS FUTURE","X")>0!($O(^GMT(142.1,"B","MAS MH CLINIC VISITS FUTURE",""))=254) D
.D MES^XPDUTL(" Environment Error: NAME or IEN collision with MAS MH CLINIC VISITS FUTURE.") S GMTSABRT=1
;
I +$$LU(142.1,"MH HIGH RISK PRF HX","X")>0!($O(^GMT(142.1,"B","MH HIGH RISK PRF HX",""))=255) D
.D MES^XPDUTL(" Environment Error: NAME or IEN collision with MH HIGH RISK PRF HX.") S GMTSABRT=1
;
I +$$LU(142.1,"MH TREATMENT COORDINATOR","X")>0!($O(^GMT(142.1,"B","MH TREATMENT COORDINATOR",""))=256) D
.D MES^XPDUTL(" Environment Error: NAME or IEN collision with MH TREATMENT COORDINATOR.") S GMTSABRT=1
;
I +$G(GMTSABRT) D BMES^XPDUTL(" Health Summary Component file IENs 253, 254, 255 and 256 must be empty or non-existent.")
I +$G(GMTSABRT) D BMES^XPDUTL(" Please re-install GMTS*2.7*99 after the necessary changes have been made.") S XPDABORT=1 Q
Q
;
LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ; call FileMan Finder to look up file entry
Q $$FIND1^DIC(FILE,"",$G(FLAGS),NAME,$G(INDEXES),$G(SCREEN),"MSGERR")
;
PRE ; cleanup previous if exists
D DELEX
D DELCOMP
D DELHSTYP
D BMES^XPDUTL("Re-index and rebuild after housekeeping")
D BUILD^GMTSXPD3
Q
;
POST ;create components, stubs, install exchange file
D INSTUB
D BMES^XPDUTL("Installing Health Summary items and TIU/HS object.")
D SMEXINS^PXRMEXSI("EXARRAY","GMTSPI99")
D BMES^XPDUTL("Re-index and rebuild after install")
D BUILD^GMTSXPD3 ;rebuild Ad-Hoc
Q
;
DELEX ;remove prior version of exchange entry
N ARRAY,IC,IND,LIST,GMTSVAL,NUM
D BMES^XPDUTL("Cleaning up any previous versions of Reminder Exchange file entry")
D EXARRAY("L",.ARRAY)
S IC=0
F S IC=$O(ARRAY(IC)) Q:'IC D
. S GMTSVAL(1)=ARRAY(IC,1)
. D FIND^DIC(811.8,"","","U",.GMTSVAL,"","","","","LIST")
. I '$D(LIST) Q
. S NUM=$P(LIST("DILIST",0),U,1)
. I NUM'=0 D
.. F IND=1:1:NUM D
... N DA,DIK
... S DIK="^PXD(811.8,"
... S DA=LIST("DILIST",2,IND)
... D ^DIK
Q
;
DELCOMP ;delete HS components
D BMES^XPDUTL("Cleaning up any previous test versions of Health Summary Components")
N DA,DIK,X,Y,NAME,COUNT,IDX,I,GMTSVAL
S DIK="^GMT(142.1,"
S DA=252
;check IEN 252, if NOT Medication Worksheet, then delete.
I $D(^GMT(142.1,DA)) D
.D:$P(^GMT(142.1,DA,0),U)='"Medication Worksheet (Tool #2)" ^DIK
S DA=""
S NAME="MAS CONTACTS^MAS MH CLINIC VISITS FUTURE^MH HIGH RISK PRF HX^MH TREATMENT COORDINATOR"
F I=1:1:4 D
.S GMTSVAL=$P(NAME,U,I)
.D FIND^DIC(142.1,"","","X",GMTSVAL,"","","","","LIST")
.I '$D(LIST) Q
.S COUNT=$P(LIST("DILIST",0),U,1)
.I COUNT'=0 D
..F IDX=1:1:COUNT D
...N DA,DIK
...S DIK="^GMT(142.1,"
...S DA=LIST("DILIST",2,IDX)
...D ^DIK
Q
DELHSTYP ; remove HS Types
D BMES^XPDUTL("Cleaning up any previous versions of Health Summary Types")
N DA,DIK,X,Y
S DIK="^GMT(142,"
S DA=5000020 D ^DIK
S DA=$O(^GMT(142,"B","VA-MH HIGH RISK PATIENT","")) D:+$G(DA) ^DIK
Q
;
EXARRAY(MODE,ARRAY) ;List of exchange entries used by delete and install
;MODE values: I for include in build, A for include action.
N LN
S LN=0
;
S LN=LN+1
S ARRAY(LN,1)="GMTS FOR HRMH"
I MODE["I" S ARRAY(LN,2)="12/01/2011@11:10:12"
I MODE["A" S ARRAY(LN,3)="O"
;
Q
;
INSTUB ;create stubs for 142
;UPDATE^DIE(FLAGS,FDA_ROOT,IEN_ROOT,MSG_ROOT)
D BMES^XPDUTL("Creating stub entries for Health Summary Types.")
N FDA,MSG,HSIEN,NAME,NUMBER,I
S NAME="MAS CONTACTS^MAS MH CLINIC VISITS FUTURE^MH HIGH RISK PRF HX^MH TREATMENT COORDINATOR"
S NUMBER="253^254^255^256"
F I=1:1:4 D
.K FDA,HSIEN,MSG
.S HSIEN(1)=$P(NUMBER,U,I)
.S FDA(142.1,"+1,",.01)=$P(NAME,U,I)
.D UPDATE^DIE("","FDA","HSIEN","MSG")
.I $D(MSG)>0 D AWRITE("MSG")
;
;
K FDA,MSG,HSIEN
S FDA(142,"+1,",.01)="REMOTE MH HIGH RISK PATIENT"
S HSIEN(1)=5000020
D UPDATE^DIE("","FDA","HSIEN","MSG")
I $D(MSG)>0 D AWRITE("MSG")
D CLEAN^DILF
Q
;
AWRITE(REF) ;Write all the descendants of the array reference.
;REF is the starting array reference, for example A or ^TMP("PXRM",$J).
;coied from PXRMUTIL
N DONE,IND,LEN,LN,PROOT,ROOT,START,TEMP,GMTSTEXT
I REF="" Q
S LN=0
S PROOT=$P(REF,")",1)
;Build the root so we can tell when we are done.
S TEMP=$NA(@REF)
S ROOT=$P(TEMP,")",1)
S REF=$Q(@REF)
I REF'[ROOT Q
S DONE=0
F Q:(REF="")!(DONE) D
. S START=$F(REF,ROOT)
. S LEN=$L(REF)
. S IND=$E(REF,START,LEN)
. S LN=LN+1,GMTSTEXT(LN)=PROOT_IND_"="_@REF
. S REF=$Q(@REF)
. I REF'[ROOT S DONE=1
D MES^XPDUTL(.GMTSTEXT)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSPI99 5469 printed Nov 22, 2024@17:09:23 Page 2
GMTSPI99 ;SLC/WAT - INSTALL ROUTINES FOR HRMH GMTS COMPONENTS ;12/01/11 11:13
+1 ;;2.7;Health Summary;**99**;Oct 20, 1995;Build 45
+2 ;
+3 ;UPDATE^DIE 2053
+4 ;^DIK 10013
+5 ;FIND and $$FIND1^DIC 2051
+6 ;CLEAN^DILF 2054
+7 ;B/MES^XPDUTL, $$PATCH^XPDUTL 10141
+8 ;^PXRMEXSI 4371
+9 ;5687 - allows GMTS to transport Reminder Exchange files in KIDS build
+10 ;
+11 ; check enviro-abort if 99 already installed. if national IENs are already used or HS component name already exists, abort and advise.
+12 NEW GMTSABRT
+13 IF $$PATCH^XPDUTL("GMTS*2.7*99")
DO BMES^XPDUTL("GMTS*2.7*99 has been previously installed. Environment check complete.")
QUIT
+14 DO BMES^XPDUTL(" Verifying installation environment...")
+15 DO MES^XPDUTL("Checking Health Summary Component file (#142.1)")
+16 IF +$$LU(142.1,"MAS CONTACTS","X")>0!($ORDER(^GMT(142.1,"B","MAS CONTACTS",""))=253)
Begin DoDot:1
+17 DO MES^XPDUTL(" Environment Error: NAME or IEN collision with MAS CONTACTS.")
SET GMTSABRT=1
End DoDot:1
+18 ;
+19 IF +$$LU(142.1,"MAS MH CLINIC VISITS FUTURE","X")>0!($ORDER(^GMT(142.1,"B","MAS MH CLINIC VISITS FUTURE",""))=254)
Begin DoDot:1
+20 DO MES^XPDUTL(" Environment Error: NAME or IEN collision with MAS MH CLINIC VISITS FUTURE.")
SET GMTSABRT=1
End DoDot:1
+21 ;
+22 IF +$$LU(142.1,"MH HIGH RISK PRF HX","X")>0!($ORDER(^GMT(142.1,"B","MH HIGH RISK PRF HX",""))=255)
Begin DoDot:1
+23 DO MES^XPDUTL(" Environment Error: NAME or IEN collision with MH HIGH RISK PRF HX.")
SET GMTSABRT=1
End DoDot:1
+24 ;
+25 IF +$$LU(142.1,"MH TREATMENT COORDINATOR","X")>0!($ORDER(^GMT(142.1,"B","MH TREATMENT COORDINATOR",""))=256)
Begin DoDot:1
+26 DO MES^XPDUTL(" Environment Error: NAME or IEN collision with MH TREATMENT COORDINATOR.")
SET GMTSABRT=1
End DoDot:1
+27 ;
+28 IF +$GET(GMTSABRT)
DO BMES^XPDUTL(" Health Summary Component file IENs 253, 254, 255 and 256 must be empty or non-existent.")
+29 IF +$GET(GMTSABRT)
DO BMES^XPDUTL(" Please re-install GMTS*2.7*99 after the necessary changes have been made.")
SET XPDABORT=1
QUIT
+30 QUIT
+31 ;
LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ; call FileMan Finder to look up file entry
+1 QUIT $$FIND1^DIC(FILE,"",$GET(FLAGS),NAME,$GET(INDEXES),$GET(SCREEN),"MSGERR")
+2 ;
PRE ; cleanup previous if exists
+1 DO DELEX
+2 DO DELCOMP
+3 DO DELHSTYP
+4 DO BMES^XPDUTL("Re-index and rebuild after housekeeping")
+5 DO BUILD^GMTSXPD3
+6 QUIT
+7 ;
POST ;create components, stubs, install exchange file
+1 DO INSTUB
+2 DO BMES^XPDUTL("Installing Health Summary items and TIU/HS object.")
+3 DO SMEXINS^PXRMEXSI("EXARRAY","GMTSPI99")
+4 DO BMES^XPDUTL("Re-index and rebuild after install")
+5 ;rebuild Ad-Hoc
DO BUILD^GMTSXPD3
+6 QUIT
+7 ;
DELEX ;remove prior version of exchange entry
+1 NEW ARRAY,IC,IND,LIST,GMTSVAL,NUM
+2 DO BMES^XPDUTL("Cleaning up any previous versions of Reminder Exchange file entry")
+3 DO EXARRAY("L",.ARRAY)
+4 SET IC=0
+5 FOR
SET IC=$ORDER(ARRAY(IC))
if 'IC
QUIT
Begin DoDot:1
+6 SET GMTSVAL(1)=ARRAY(IC,1)
+7 DO FIND^DIC(811.8,"","","U",.GMTSVAL,"","","","","LIST")
+8 IF '$DATA(LIST)
QUIT
+9 SET NUM=$PIECE(LIST("DILIST",0),U,1)
+10 IF NUM'=0
Begin DoDot:2
+11 FOR IND=1:1:NUM
Begin DoDot:3
+12 NEW DA,DIK
+13 SET DIK="^PXD(811.8,"
+14 SET DA=LIST("DILIST",2,IND)
+15 DO ^DIK
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
DELCOMP ;delete HS components
+1 DO BMES^XPDUTL("Cleaning up any previous test versions of Health Summary Components")
+2 NEW DA,DIK,X,Y,NAME,COUNT,IDX,I,GMTSVAL
+3 SET DIK="^GMT(142.1,"
+4 SET DA=252
+5 ;check IEN 252, if NOT Medication Worksheet, then delete.
+6 IF $DATA(^GMT(142.1,DA))
Begin DoDot:1
+7 if $PIECE(^GMT(142.1,DA,0),U)='"Medication Worksheet (Tool #2)"
DO ^DIK
End DoDot:1
+8 SET DA=""
+9 SET NAME="MAS CONTACTS^MAS MH CLINIC VISITS FUTURE^MH HIGH RISK PRF HX^MH TREATMENT COORDINATOR"
+10 FOR I=1:1:4
Begin DoDot:1
+11 SET GMTSVAL=$PIECE(NAME,U,I)
+12 DO FIND^DIC(142.1,"","","X",GMTSVAL,"","","","","LIST")
+13 IF '$DATA(LIST)
QUIT
+14 SET COUNT=$PIECE(LIST("DILIST",0),U,1)
+15 IF COUNT'=0
Begin DoDot:2
+16 FOR IDX=1:1:COUNT
Begin DoDot:3
+17 NEW DA,DIK
+18 SET DIK="^GMT(142.1,"
+19 SET DA=LIST("DILIST",2,IDX)
+20 DO ^DIK
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
DELHSTYP ; remove HS Types
+1 DO BMES^XPDUTL("Cleaning up any previous versions of Health Summary Types")
+2 NEW DA,DIK,X,Y
+3 SET DIK="^GMT(142,"
+4 SET DA=5000020
DO ^DIK
+5 SET DA=$ORDER(^GMT(142,"B","VA-MH HIGH RISK PATIENT",""))
if +$GET(DA)
DO ^DIK
+6 QUIT
+7 ;
EXARRAY(MODE,ARRAY) ;List of exchange entries used by delete and install
+1 ;MODE values: I for include in build, A for include action.
+2 NEW LN
+3 SET LN=0
+4 ;
+5 SET LN=LN+1
+6 SET ARRAY(LN,1)="GMTS FOR HRMH"
+7 IF MODE["I"
SET ARRAY(LN,2)="12/01/2011@11:10:12"
+8 IF MODE["A"
SET ARRAY(LN,3)="O"
+9 ;
+10 QUIT
+11 ;
INSTUB ;create stubs for 142
+1 ;UPDATE^DIE(FLAGS,FDA_ROOT,IEN_ROOT,MSG_ROOT)
+2 DO BMES^XPDUTL("Creating stub entries for Health Summary Types.")
+3 NEW FDA,MSG,HSIEN,NAME,NUMBER,I
+4 SET NAME="MAS CONTACTS^MAS MH CLINIC VISITS FUTURE^MH HIGH RISK PRF HX^MH TREATMENT COORDINATOR"
+5 SET NUMBER="253^254^255^256"
+6 FOR I=1:1:4
Begin DoDot:1
+7 KILL FDA,HSIEN,MSG
+8 SET HSIEN(1)=$PIECE(NUMBER,U,I)
+9 SET FDA(142.1,"+1,",.01)=$PIECE(NAME,U,I)
+10 DO UPDATE^DIE("","FDA","HSIEN","MSG")
+11 IF $DATA(MSG)>0
DO AWRITE("MSG")
End DoDot:1
+12 ;
+13 ;
+14 KILL FDA,MSG,HSIEN
+15 SET FDA(142,"+1,",.01)="REMOTE MH HIGH RISK PATIENT"
+16 SET HSIEN(1)=5000020
+17 DO UPDATE^DIE("","FDA","HSIEN","MSG")
+18 IF $DATA(MSG)>0
DO AWRITE("MSG")
+19 DO CLEAN^DILF
+20 QUIT
+21 ;
AWRITE(REF) ;Write all the descendants of the array reference.
+1 ;REF is the starting array reference, for example A or ^TMP("PXRM",$J).
+2 ;coied from PXRMUTIL
+3 NEW DONE,IND,LEN,LN,PROOT,ROOT,START,TEMP,GMTSTEXT
+4 IF REF=""
QUIT
+5 SET LN=0
+6 SET PROOT=$PIECE(REF,")",1)
+7 ;Build the root so we can tell when we are done.
+8 SET TEMP=$NAME(@REF)
+9 SET ROOT=$PIECE(TEMP,")",1)
+10 SET REF=$QUERY(@REF)
+11 IF REF'[ROOT
QUIT
+12 SET DONE=0
+13 FOR
if (REF="")!(DONE)
QUIT
Begin DoDot:1
+14 SET START=$FIND(REF,ROOT)
+15 SET LEN=$LENGTH(REF)
+16 SET IND=$EXTRACT(REF,START,LEN)
+17 SET LN=LN+1
SET GMTSTEXT(LN)=PROOT_IND_"="_@REF
+18 SET REF=$QUERY(@REF)
+19 IF REF'[ROOT
SET DONE=1
End DoDot:1
+20 DO MES^XPDUTL(.GMTSTEXT)
+21 QUIT
+22 ;
