GMTSY104.m

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 ---GMTSY104   2668     printed  Feb 18, 2025@23:27:38                                                                                                                                                                                                    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      ;