GMTSPI98 ;SLC/WAT - Post Install GMTS*2.7*98 ;03/02/17 11:13
;;2.7;Health Summary;**98**;Oct 20, 1995;Build 88
;;
;INTEGRATION CONTROL REGISTRATION
;UPDATE^DIE #2053
;FIND1^DIC #3217
;FIND^DIC #2051
;MES and $$PATCH^XPDUTL #10141
;^PXRMEXSI #4371
;READ OF REMINDER EXCHANGE FILE ^PXD(811.8 #4586
;;ENV CHECK - ensure IENs are empty before proceeding
D BMES^XPDUTL(" Verifying installation environment...")
N GMTSABRT,GMTSRIEN,FLG18,FLG19 S (GMTSABRT,FLG18,FLG19)=0
I $$PATCH^XPDUTL("GMTS*2.7*98") D Q
. ;ensure types are at correct IEN.
. I +$O(^GMT(142,"B","REMOTE HT CLINICAL REMINDERS",""))=5000018 S FLG18=1
. I +$O(^GMT(142,"B","REMOTE HT TRACKING",""))=5000019 S FLG19=1
. I FLG18&(FLG19) D BMES^XPDUTL(" Verification complete; environment check passed ") Q
. I 'FLG18 D MSG(5000018) S GMTSABRT=1
. I 'FLG19 D MSG(5000019) S GMTSABRT=1
. I GMTSABRT D BMES^XPDUTL("Please re-install HT TEMPLATES PROJECT 1.0 when necessary changes are complete.") S XPDABORT=1 Q
F GMTSRIEN=5000018,5000019 D
.I $D(^GMT(142,GMTSRIEN)) D
..D MSG(GMTSRIEN) S GMTSABRT=1
..I +$G(GMTSABRT) D BMES^XPDUTL("Please re-install HT TEMPLATES PROJECT 1.0 when necessary changes are complete.") S XPDABORT=1 Q
D:+$G(GMTSABRT)=0 BMES^XPDUTL(" Verification complete; environment check passed ")
Q
;
MSG(IEN) ;abort message to screen
D BMES^XPDUTL("!!! INSTALL ABORT !!!")
D MES^XPDUTL("HEALTH SUMMARY TYPE IEN ***"_$G(IEN)_"*** is occupied.")
D MES^XPDUTL("This IEN is reserved for National REMOTE HEALTH SUMMARY TYPES and is expected")
D MES^XPDUTL("to be undefined so that GMTS*2.7*98 may install a new entry in that location.")
D MES^XPDUTL("Please DO NOT delete the file entry at "_$G(IEN))
D BMES^XPDUTL("Please DO contact the National Help Desk at 1-888-596-4357 and request")
D MES^XPDUTL("a help desk ticket be created to the NTL SUP Clin 1 team.")
Q
;
PRE ;housekeeping
D DELEXE^PXRMEXSI("EXARRAY","GMTSPI98")
D INSTUB
Q
;
POST ;post
D SMEXINS^PXRMEXSI("EXARRAY","GMTSPI98")
D GMTSET
Q
;
GMTSET ;reset ^GMT(142,0) to last low IEN
N IEN,LIEN
S IEN=0 F S IEN=$O(^GMT(142,IEN)) D Q:IEN'>0!(IEN=5000001)
.I IEN<5000000 S LIEN=IEN
I +$G(LIEN)>0 S $P(^GMT(142,0),U,3)=LIEN
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)="VA-HT REMOTE HEALTH SUMMARY TYPES"
I MODE["I" S ARRAY(LN,2)="02/15/2017@06:55:47"
I MODE["A" S ARRAY(LN,3)="O"
Q
;
INSTUB ; create stubs for REMOTE types
;if already there, no need for stubs - rem exch will overwrite existing entries so always left with current
;ensure IENs are empty before adding new stubs
I +$O(^GMT(142,"B","REMOTE HT CLINICAL REMINDERS",""))=5000018,+$O(^GMT(142,"B","REMOTE HT TRACKING",""))=5000019 Q
N FDA,MSG,HSIEN
I $D(^GMT(142,5000018,0))=0 D
.S FDA(1,142,"+1,",.01)="REMOTE HT CLINICAL REMINDERS"
.S HSIEN(1)=5000018
.D UPDATE^DIE("S","FDA(1)","HSIEN","MSG")
I $D(^GMT(142,5000019,0))=0 D
.S FDA(1,142,"+1,",.01)="REMOTE HT TRACKING"
.S HSIEN(1)=5000019
.D UPDATE^DIE("","FDA(1)","HSIEN","MSG")
.I $D(MSG)>0 D AWRITE("MSG")
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,TEXT
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,TEXT(LN)=PROOT_IND_"="_@REF
. S REF=$Q(@REF)
. I REF'[ROOT S DONE=1
D MES^XPDUTL(.TEXT)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSPI98 3852 printed Dec 13, 2024@01:59:14 Page 2
GMTSPI98 ;SLC/WAT - Post Install GMTS*2.7*98 ;03/02/17 11:13
+1 ;;2.7;Health Summary;**98**;Oct 20, 1995;Build 88
+2 ;;
+3 ;INTEGRATION CONTROL REGISTRATION
+4 ;UPDATE^DIE #2053
+5 ;FIND1^DIC #3217
+6 ;FIND^DIC #2051
+7 ;MES and $$PATCH^XPDUTL #10141
+8 ;^PXRMEXSI #4371
+9 ;READ OF REMINDER EXCHANGE FILE ^PXD(811.8 #4586
+10 ;;ENV CHECK - ensure IENs are empty before proceeding
+11 DO BMES^XPDUTL(" Verifying installation environment...")
+12 NEW GMTSABRT,GMTSRIEN,FLG18,FLG19
SET (GMTSABRT,FLG18,FLG19)=0
+13 IF $$PATCH^XPDUTL("GMTS*2.7*98")
Begin DoDot:1
+14 ;ensure types are at correct IEN.
+15 IF +$ORDER(^GMT(142,"B","REMOTE HT CLINICAL REMINDERS",""))=5000018
SET FLG18=1
+16 IF +$ORDER(^GMT(142,"B","REMOTE HT TRACKING",""))=5000019
SET FLG19=1
+17 IF FLG18&(FLG19)
DO BMES^XPDUTL(" Verification complete; environment check passed ")
QUIT
+18 IF 'FLG18
DO MSG(5000018)
SET GMTSABRT=1
+19 IF 'FLG19
DO MSG(5000019)
SET GMTSABRT=1
+20 IF GMTSABRT
DO BMES^XPDUTL("Please re-install HT TEMPLATES PROJECT 1.0 when necessary changes are complete.")
SET XPDABORT=1
QUIT
End DoDot:1
QUIT
+21 FOR GMTSRIEN=5000018,5000019
Begin DoDot:1
+22 IF $DATA(^GMT(142,GMTSRIEN))
Begin DoDot:2
+23 DO MSG(GMTSRIEN)
SET GMTSABRT=1
+24 IF +$GET(GMTSABRT)
DO BMES^XPDUTL("Please re-install HT TEMPLATES PROJECT 1.0 when necessary changes are complete.")
SET XPDABORT=1
QUIT
End DoDot:2
End DoDot:1
+25 if +$GET(GMTSABRT)=0
DO BMES^XPDUTL(" Verification complete; environment check passed ")
+26 QUIT
+27 ;
MSG(IEN) ;abort message to screen
+1 DO BMES^XPDUTL("!!! INSTALL ABORT !!!")
+2 DO MES^XPDUTL("HEALTH SUMMARY TYPE IEN ***"_$GET(IEN)_"*** is occupied.")
+3 DO MES^XPDUTL("This IEN is reserved for National REMOTE HEALTH SUMMARY TYPES and is expected")
+4 DO MES^XPDUTL("to be undefined so that GMTS*2.7*98 may install a new entry in that location.")
+5 DO MES^XPDUTL("Please DO NOT delete the file entry at "_$GET(IEN))
+6 DO BMES^XPDUTL("Please DO contact the National Help Desk at 1-888-596-4357 and request")
+7 DO MES^XPDUTL("a help desk ticket be created to the NTL SUP Clin 1 team.")
+8 QUIT
+9 ;
PRE ;housekeeping
+1 DO DELEXE^PXRMEXSI("EXARRAY","GMTSPI98")
+2 DO INSTUB
+3 QUIT
+4 ;
POST ;post
+1 DO SMEXINS^PXRMEXSI("EXARRAY","GMTSPI98")
+2 DO GMTSET
+3 QUIT
+4 ;
GMTSET ;reset ^GMT(142,0) to last low IEN
+1 NEW IEN,LIEN
+2 SET IEN=0
FOR
SET IEN=$ORDER(^GMT(142,IEN))
Begin DoDot:1
+3 IF IEN<5000000
SET LIEN=IEN
End DoDot:1
if IEN'>0!(IEN=5000001)
QUIT
+4 IF +$GET(LIEN)>0
SET $PIECE(^GMT(142,0),U,3)=LIEN
+5 QUIT
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)="VA-HT REMOTE HEALTH SUMMARY TYPES"
+7 IF MODE["I"
SET ARRAY(LN,2)="02/15/2017@06:55:47"
+8 IF MODE["A"
SET ARRAY(LN,3)="O"
+9 QUIT
+10 ;
INSTUB ; create stubs for REMOTE types
+1 ;if already there, no need for stubs - rem exch will overwrite existing entries so always left with current
+2 ;ensure IENs are empty before adding new stubs
+3 IF +$ORDER(^GMT(142,"B","REMOTE HT CLINICAL REMINDERS",""))=5000018
IF +$ORDER(^GMT(142,"B","REMOTE HT TRACKING",""))=5000019
QUIT
+4 NEW FDA,MSG,HSIEN
+5 IF $DATA(^GMT(142,5000018,0))=0
Begin DoDot:1
+6 SET FDA(1,142,"+1,",.01)="REMOTE HT CLINICAL REMINDERS"
+7 SET HSIEN(1)=5000018
+8 DO UPDATE^DIE("S","FDA(1)","HSIEN","MSG")
End DoDot:1
+9 IF $DATA(^GMT(142,5000019,0))=0
Begin DoDot:1
+10 SET FDA(1,142,"+1,",.01)="REMOTE HT TRACKING"
+11 SET HSIEN(1)=5000019
+12 DO UPDATE^DIE("","FDA(1)","HSIEN","MSG")
+13 IF $DATA(MSG)>0
DO AWRITE("MSG")
End DoDot:1
+14 QUIT
+15 ;
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,TEXT
+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 TEXT(LN)=PROOT_IND_"="_@REF
+18 SET REF=$QUERY(@REF)
+19 IF REF'[ROOT
SET DONE=1
End DoDot:1
+20 DO MES^XPDUTL(.TEXT)
+21 QUIT
+22 ;
