GMTSY104 ;BP/WAT - POST-INSTALL PATCH 104 ;04/19/12 15:25
;;2.7;Health Summary;**104**;Oct 20, 1995;Build 38
;
;WP^DIE ;2053
;FIND1^DIC ;2051
;B/MES^XPDUTL 10141
;
; GMTS health check
N GMTSNAME,I,COUNT,GMTSABRT S GMTSNAME="",COUNT=1,GMTSABRT=""
D BMES^XPDUTL("CHECKING RECENT ADDITIONS TO HEALTH SUMMARY COMPONENT FILE")
F I=252:1:256 Q:I>256!(GMTSABRT=2) D
.S GMTSNAME=$P(^GMT(142.1,I,0),"^")
.I GMTSNAME=$P($T(TEXT+COUNT),";;",2) D BMES^XPDUTL(GMTSNAME_": OK") S COUNT=COUNT+1 Q
.D BMES^XPDUTL("The following Health Summary Component was not found in file 142.1:")
.D MES^XPDUTL($P($T(TEXT+COUNT),";;",2))
.D BMES^XPDUTL("Install will not proceed until this issue is resolved.")
.D MES^XPDUTL("Transport global will remain on the system.")
.D MES^XPDUTL("Use KIDS option XPD RESTART INSTALL when the issue is resovled.") S GMTSABRT=2
I +$G(GMTSABRT)=2 S XPDQUIT=2 ;abort and leave global on system
Q
;
TEXT ;HS Names to Check
;;Medication Worksheet (Tool #2)
;;MAS CONTACTS
;;MAS MH CLINIC VISITS FUTURE
;;MH HIGH RISK PRF HX
;;MH TREATMENT COORDINATOR
Q
;
POST ;post-install
;update MHRF component description
;WP^DIE(FILE,IENS,FIELD,FLAGS,wp_root,msg_root)
N GMTSIEN,MSG
K ^TMP($J,"WP")
D BMES^XPDUTL("Updating description for Health Summary Component MH HIGH RISK FOR SUICIDE")
S ^TMP($J,"WP",1,0)="This component displays the assignment status and history for the "
S ^TMP($J,"WP",2,0)="Category I (National) HIGH RISK FOR SUICIDE Patient Record Flag."
S ^TMP($J,"WP",3,0)="Any assignment history found for the Category II (Local) High Risk for "
S ^TMP($J,"WP",4,0)="Suicide flag will also be displayed."
S GMTSIEN=$$FIND1^DIC(142.1,"","X","MH HIGH RISK PRF HX","B",,"MSG")
I +$G(GMTSIEN)'>0 K ^TMP($J,"WP") D BMES^XPDUTL(" Error during lookup of MH HIGH RISK PRF HX component. ") D Q
.I $D(MSG)>0 D AWRITE("MSG")
K MSG
D WP^DIE(142.1,GMTSIEN_",",3.5,"K","^TMP($J,""WP"")","MSG")
I $D(MSG)>0 D AWRITE("MSG")
D:$D(MSG)'>0 BMES^XPDUTL(" Update Successful ")
Q
;
AWRITE(REF) ;Write all the descendants of the array reference.
;REF is the starting array reference, for example A or ^TMP("SOME NAME",$J).
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[HGMTSY104 2668 printed Dec 13, 2024@02:01:17 Page 2
GMTSY104 ;BP/WAT - POST-INSTALL PATCH 104 ;04/19/12 15:25
+1 ;;2.7;Health Summary;**104**;Oct 20, 1995;Build 38
+2 ;
+3 ;WP^DIE ;2053
+4 ;FIND1^DIC ;2051
+5 ;B/MES^XPDUTL 10141
+6 ;
+7 ; GMTS health check
+8 NEW GMTSNAME,I,COUNT,GMTSABRT
SET GMTSNAME=""
SET COUNT=1
SET GMTSABRT=""
+9 DO BMES^XPDUTL("CHECKING RECENT ADDITIONS TO HEALTH SUMMARY COMPONENT FILE")
+10 FOR I=252:1:256
if I>256!(GMTSABRT=2)
QUIT
Begin DoDot:1
+11 SET GMTSNAME=$PIECE(^GMT(142.1,I,0),"^")
+12 IF GMTSNAME=$PIECE($TEXT(TEXT+COUNT),";;",2)
DO BMES^XPDUTL(GMTSNAME_": OK")
SET COUNT=COUNT+1
QUIT
+13 DO BMES^XPDUTL("The following Health Summary Component was not found in file 142.1:")
+14 DO MES^XPDUTL($PIECE($TEXT(TEXT+COUNT),";;",2))
+15 DO BMES^XPDUTL("Install will not proceed until this issue is resolved.")
+16 DO MES^XPDUTL("Transport global will remain on the system.")
+17 DO MES^XPDUTL("Use KIDS option XPD RESTART INSTALL when the issue is resovled.")
SET GMTSABRT=2
End DoDot:1
+18 ;abort and leave global on system
IF +$GET(GMTSABRT)=2
SET XPDQUIT=2
+19 QUIT
+20 ;
TEXT ;HS Names to Check
+1 ;;Medication Worksheet (Tool #2)
+2 ;;MAS CONTACTS
+3 ;;MAS MH CLINIC VISITS FUTURE
+4 ;;MH HIGH RISK PRF HX
+5 ;;MH TREATMENT COORDINATOR
+6 QUIT
+7 ;
POST ;post-install
+1 ;update MHRF component description
+2 ;WP^DIE(FILE,IENS,FIELD,FLAGS,wp_root,msg_root)
+3 NEW GMTSIEN,MSG
+4 KILL ^TMP($JOB,"WP")
+5 DO BMES^XPDUTL("Updating description for Health Summary Component MH HIGH RISK FOR SUICIDE")
+6 SET ^TMP($JOB,"WP",1,0)="This component displays the assignment status and history for the "
+7 SET ^TMP($JOB,"WP",2,0)="Category I (National) HIGH RISK FOR SUICIDE Patient Record Flag."
+8 SET ^TMP($JOB,"WP",3,0)="Any assignment history found for the Category II (Local) High Risk for "
+9 SET ^TMP($JOB,"WP",4,0)="Suicide flag will also be displayed."
+10 SET GMTSIEN=$$FIND1^DIC(142.1,"","X","MH HIGH RISK PRF HX","B",,"MSG")
+11 IF +$GET(GMTSIEN)'>0
KILL ^TMP($JOB,"WP")
DO BMES^XPDUTL(" Error during lookup of MH HIGH RISK PRF HX component. ")
Begin DoDot:1
+12 IF $DATA(MSG)>0
DO AWRITE("MSG")
End DoDot:1
QUIT
+13 KILL MSG
+14 DO WP^DIE(142.1,GMTSIEN_",",3.5,"K","^TMP($J,""WP"")","MSG")
+15 IF $DATA(MSG)>0
DO AWRITE("MSG")
+16 if $DATA(MSG)'>0
DO BMES^XPDUTL(" Update Successful ")
+17 QUIT
+18 ;
AWRITE(REF) ;Write all the descendants of the array reference.
+1 ;REF is the starting array reference, for example A or ^TMP("SOME NAME",$J).
+2 NEW DONE,IND,LEN,LN,PROOT,ROOT,START,TEMP,GMTSTEXT
+3 IF REF=""
QUIT
+4 SET LN=0
+5 SET PROOT=$PIECE(REF,")",1)
+6 ;Build the root so we can tell when we are done.
+7 SET TEMP=$NAME(@REF)
+8 SET ROOT=$PIECE(TEMP,")",1)
+9 SET REF=$QUERY(@REF)
+10 IF REF'[ROOT
QUIT
+11 SET DONE=0
+12 FOR
if (REF="")!(DONE)
QUIT
Begin DoDot:1
+13 SET START=$FIND(REF,ROOT)
+14 SET LEN=$LENGTH(REF)
+15 SET IND=$EXTRACT(REF,START,LEN)
+16 SET LN=LN+1
SET GMTSTEXT(LN)=PROOT_IND_"="_@REF
+17 SET REF=$QUERY(@REF)
+18 IF REF'[ROOT
SET DONE=1
End DoDot:1
+19 DO MES^XPDUTL(.GMTSTEXT)
+20 QUIT
+21 ;
