Routine: GMTSADH

GMTSADH ;SLC/JER,MAM - Ad Hoc Summary Driver ; 09/21/2001

 ;;2.7;Health Summary;**30,35,47**;Oct 20, 1995

 ; External References

 ;   DBIA 10035  ^DPT(

 ;   DBIA   148  PATIENT^ORU1

 ;   DBIA 10141  $$VERSION^XPDUTL

 ;   DBIA    82  EN^XQORM

 ;   DBIA 10026  ^DIR

 ;   DBIA 10102  DISP^XQORM1

MAIN ; Ad Hoc Health Summary Driver

 N C,DFN,GMTSEG,GMTSEGI,GMTSEGC,GMTSQIT,GMTSTYP,GMTSTITL,GMW,X,Y,DIC,DIPGM,I,POP,%,DIROUT,DUOUT,DTOUT,ZTRTN,GMTSQIT,FROM,GMI,I1,ISVALID,LRDFN,PTR,SEX,TO,VAOA,VASD,VASV

 I $L($T(PATIENT^ORU1)),($$VERSION^XPDUTL("OR")>2.19) D MAIN^GMTSADHC Q

 S DIC=142,DIC(0)="MZF",X="GMTS HS ADHOC OPTION",Y=$$TYPE^GMTSULT K DIC S GMTSTYP=+Y,GMTSTITL="AD HOC"

 F  K GMTSEG,GMTSEGI,GMTSEGC D BUILD D  Q:$D(DIROUT)!$D(DUOUT)!$D(DTOUT)

 . N GMPAT,DFN,GMTSMULT F  D  Q:$D(DIROUT)!$D(DUOUT)!$D(DTOUT)!(+$D(GMPAT)'>0)

 . . Q:$D(DIROUT)!$D(DUOUT)!$D(DTOUT)

 . . K GMPAT,GMTSMULT F  Q:$D(DIROUT)  K DFN W ! D SELPT^GMTS Q:+($G(DFN))'>0  D

 . . . N GMNAME S GMNAME=$P($G(^DPT(+DFN,0)),U) Q:GMNAME=""  S GMPAT(GMNAME,+($G(DFN)))=+($G(DFN))

 . . Q:$D(DIROUT)!$D(DUOUT)!$D(DTOUT)!(+$D(GMPAT)'>0)

 . . D RESUB^GMTSDVR(.GMPAT) S ZTRTN="PQ^GMTS" N DUOUT D HSOUT^GMTSDVR,END^GMTS W !

BUILD ; Conducts Dialogue to build Ad Hoc Summary

 N GMI,GMJ,GMW,X,XQORM,Y Q:$D(GMTSQIT)!($D(DIROUT))  W @IOF

 S XQORM("S")="I $D(^GMT(142,DA(1),1,DA,0)),($P(^GMT(142.1,$P(^GMT(142,DA(1),1,DA,0),U,2),0),U,6)'=""T"")",XQORM("M")=6

 S XQORM=GMTSTYP_";GMT(142,",XQORM(0)="AD",XQORM("A")="Select NEW set of COMPONENT(S): ",XQORM("??")="D HELP^GMTSADH" D EN^XQORM I Y'>0 S DIROUT=1 Q

 G:+Y&(X?1"^^".E) BUILD S GMTSEGC=Y,(X,GMI,GMJ)=0 F  S GMI=$O(Y(GMI)) Q:'GMI  D LOAD

 D GETLIM^GMTSADH1

LOAD ; Load enabled components

 N SREC,STRN S STRN=+Y(GMI),SREC=^GMT(142,GMTSTYP,1,STRN,0)

LOAD1 ; Load array GMTSEG and GMTSEGI

 S GMJ=GMJ+1,GMTSEG(GMJ)=SREC,GMTSEGI($P(SREC,U,2))=GMJ D LOADSEL

LOADSEL ; Loads GMTSEG(J,FN,IFN)   (Selection Items)

 N S2,SJ,SEL,SR,SF S S2=0,SJ=GMJ

 F  S S2=$O(^GMT(142,GMTSTYP,1,STRN,1,S2)) Q:'S2  D

 . S SEL=^(S2,0),SR=U_$P(SEL,";",2) Q:SR="^"

 . S SF=+$P(@(SR_"0)"),U,2) Q:+SF=0

 . S GMTSEG(GMJ,SF,S2)=$P(SEL,";"),GMTSEG(GMJ,SF,0)=SR

HELP ; Display Help Text

 N GMJ,GMTSTXT,HLP S HLP=$S(X="??":"HTX2",X="?":"HTX1",1:"") I $L(HLP) W ! F GMJ=1:1 S GMTSTXT=$T(@HLP+GMJ) Q:GMTSTXT["ZZZZ"  W !,$P(GMTSTXT,";",3,99)

 I X="???" W !! D HELP2^GMTSUP1

 D REDISP

REDISP ; Ask Whether or not to redisplay menu

 N I,DIR,X,Y S DIR(0)="Y",DIR("A")="Redisplay items",DIR("B")="YES" D ^DIR Q:'Y

 W @IOF D DISP^XQORM1 W !

HTX1 ;; Help Text for "?" and "??"

 ;; Select ONE or MORE items from the menu, separated by commas.

;;

 ;; Enter: ??  to see HELP for MULTIPLE SELECTION

 ;;        ??? to see HELP for "^^"-jump

;;

 ;;ZZZZ

HTX2 ;; Help Text for ??

;;

 ;; The Health Summary components you select at this prompt create

 ;; an ADHOC Health Summary.

;;

 ;; Select ONE or MORE items from the menu, separated by commas.

;;

 ;; ALL items may be selected by typing "ALL".

;;

 ;; EXCEPTIONS may be entered by preceding them with a minus.

 ;;   For example, "ALL,-THIS,-THAT" selects all but "THIS" and "THAT".

;;

 ;; NOTE: Menu items are ordered alphabetically by the Component NAME.

 ;;       However, the displayed text is the Header Name which generally

 ;;       is different from the Component Name. Component may be picked

 ;;       by their abbreviation, Header Name or Component Name.

;;

 ;;ZZZZ

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSADH   3508     printed  Feb 18, 2025@23:23:18                                                                                                                                                                                                     Page 2

GMTSADH   ;SLC/JER,MAM - Ad Hoc Summary Driver ; 09/21/2001

 +1       ;;2.7;Health Summary;**30,35,47**;Oct 20, 1995

 +2       ;

 +3       ; External References

 +4       ;   DBIA 10035  ^DPT(

 +5       ;   DBIA   148  PATIENT^ORU1

 +6       ;   DBIA 10141  $$VERSION^XPDUTL

 +7       ;   DBIA    82  EN^XQORM

 +8       ;   DBIA 10026  ^DIR

 +9       ;   DBIA 10102  DISP^XQORM1

 +10      ;

MAIN      ; Ad Hoc Health Summary Driver

 +1        NEW C,DFN,GMTSEG,GMTSEGI,GMTSEGC,GMTSQIT,GMTSTYP,GMTSTITL,GMW,X,Y,DIC,DIPGM,I,POP,%,DIROUT,DUOUT,DTOUT,ZTRTN,GMTSQIT,FROM,GMI,I1,ISVALID,LRDFN,PTR,SEX,TO,VAOA,VASD,VASV

 +2        IF $LENGTH($TEXT(PATIENT^ORU1))

               IF ($$VERSION^XPDUTL("OR")>2.19)

                   DO MAIN^GMTSADHC

                   QUIT

 +3        SET DIC=142

           SET DIC(0)="MZF"

           SET X="GMTS HS ADHOC OPTION"

           SET Y=$$TYPE^GMTSULT

           KILL DIC

           SET GMTSTYP=+Y

           SET GMTSTITL="AD HOC"

 +4        FOR

               KILL GMTSEG,GMTSEGI,GMTSEGC

               DO BUILD

               Begin DoDot:1

 +5                NEW GMPAT,DFN,GMTSMULT

FOR

                       Begin DoDot:2

 +6                        if $DATA(DIROUT)!$DATA(DUOUT)!$DATA(DTOUT)

                               QUIT

 +7                        KILL GMPAT,GMTSMULT

FOR

                               if $DATA(DIROUT)

                                   QUIT

                               KILL DFN

                               WRITE !

                               DO SELPT^GMTS

                               if +($GET(DFN))'>0

                                   QUIT

                               Begin DoDot:3

 +8                                NEW GMNAME

                                   SET GMNAME=$PIECE($GET(^DPT(+DFN,0)),U)

                                   if GMNAME=""

                                       QUIT

                                   SET GMPAT(GMNAME,+($GET(DFN)))=+($GET(DFN))

                               End DoDot:3

 +9                        if $DATA(DIROUT)!$DATA(DUOUT)!$DATA(DTOUT)!(+$DATA(GMPAT)'>0)

                               QUIT

 +10                       DO RESUB^GMTSDVR(.GMPAT)

                           SET ZTRTN="PQ^GMTS"

                           NEW DUOUT

                           DO HSOUT^GMTSDVR

                           DO END^GMTS

                           WRITE !

                       End DoDot:2

                       if $DATA(DIROUT)!$DATA(DUOUT)!$DATA(DTOUT)!(+$DATA(GMPAT)'>0)

                           QUIT

               End DoDot:1

               if $DATA(DIROUT)!$DATA(DUOUT)!$DATA(DTOUT)

                   QUIT

 +11       QUIT

BUILD     ; Conducts Dialogue to build Ad Hoc Summary

 +1        NEW GMI,GMJ,GMW,X,XQORM,Y

           if $DATA(GMTSQIT)!($DATA(DIROUT))

               QUIT

           WRITE @IOF

 +2        SET XQORM("S")="I $D(^GMT(142,DA(1),1,DA,0)),($P(^GMT(142.1,$P(^GMT(142,DA(1),1,DA,0),U,2),0),U,6)'=""T"")"

           SET XQORM("M")=6

 +3        SET XQORM=GMTSTYP_";GMT(142,"

           SET XQORM(0)="AD"

           SET XQORM("A")="Select NEW set of COMPONENT(S): "

           SET XQORM("??")="D HELP^GMTSADH"

           DO EN^XQORM

           IF Y'>0

               SET DIROUT=1

               QUIT

 +4        if +Y&(X?1"^^".E)

               GOTO BUILD

           SET GMTSEGC=Y

           SET (X,GMI,GMJ)=0

FOR

               SET GMI=$ORDER(Y(GMI))

               if 'GMI

                   QUIT

               DO LOAD

 +5        DO GETLIM^GMTSADH1

 +6        QUIT

LOAD      ; Load enabled components

 +1        NEW SREC,STRN

           SET STRN=+Y(GMI)

           SET SREC=^GMT(142,GMTSTYP,1,STRN,0)

LOAD1     ; Load array GMTSEG and GMTSEGI

 +1        SET GMJ=GMJ+1

           SET GMTSEG(GMJ)=SREC

           SET GMTSEGI($PIECE(SREC,U,2))=GMJ

           DO LOADSEL

 +2        QUIT

LOADSEL   ; Loads GMTSEG(J,FN,IFN)   (Selection Items)

 +1        NEW S2,SJ,SEL,SR,SF

           SET S2=0

           SET SJ=GMJ

 +2        FOR

               SET S2=$ORDER(^GMT(142,GMTSTYP,1,STRN,1,S2))

               if 'S2

                   QUIT

               Begin DoDot:1

 +3                SET SEL=^(S2,0)

                   SET SR=U_$PIECE(SEL,";",2)

                   if SR="^"

                       QUIT

 +4                SET SF=+$PIECE(@(SR_"0)"),U,2)

                   if +SF=0

                       QUIT

 +5                SET GMTSEG(GMJ,SF,S2)=$PIECE(SEL,";")

                   SET GMTSEG(GMJ,SF,0)=SR

               End DoDot:1

 +6        QUIT

HELP      ; Display Help Text

 +1        NEW GMJ,GMTSTXT,HLP

           SET HLP=$SELECT(X="??":"HTX2",X="?":"HTX1",1:"")

           IF $LENGTH(HLP)

               WRITE !

               FOR GMJ=1:1

                   SET GMTSTXT=$TEXT(@HLP+GMJ)

                   if GMTSTXT["ZZZZ"

                       QUIT

                   WRITE !,$PIECE(GMTSTXT,";",3,99)

 +2        IF X="???"

               WRITE !!

               DO HELP2^GMTSUP1

 +3        DO REDISP

 +4        QUIT

REDISP    ; Ask Whether or not to redisplay menu

 +1        NEW I,DIR,X,Y

           SET DIR(0)="Y"

           SET DIR("A")="Redisplay items"

           SET DIR("B")="YES"

           DO ^DIR

           if 'Y

               QUIT

 +2        WRITE @IOF

           DO DISP^XQORM1

           WRITE !

 +3        QUIT

HTX1      ;; Help Text for "?" and "??"

 +1       ;; Select ONE or MORE items from the menu, separated by commas.

 +2       ;;

 +3       ;; Enter: ??  to see HELP for MULTIPLE SELECTION

 +4       ;;        ??? to see HELP for "^^"-jump

 +5       ;;

 +6       ;;ZZZZ

HTX2      ;; Help Text for ??

 +1       ;;

 +2       ;; The Health Summary components you select at this prompt create

 +3       ;; an ADHOC Health Summary.

 +4       ;;

 +5       ;; Select ONE or MORE items from the menu, separated by commas.

 +6       ;;

 +7       ;; ALL items may be selected by typing "ALL".

 +8       ;;

 +9       ;; EXCEPTIONS may be entered by preceding them with a minus.

 +10      ;;   For example, "ALL,-THIS,-THAT" selects all but "THIS" and "THAT".

 +11      ;;

 +12      ;; NOTE: Menu items are ordered alphabetically by the Component NAME.

 +13      ;;       However, the displayed text is the Header Name which generally

 +14      ;;       is different from the Component Name. Component may be picked

 +15      ;;       by their abbreviation, Header Name or Component Name.

 +16      ;;

 +17      ;;ZZZZ

GMTSADH.m