GMTSADHC.m

GMTSADHC ; SLC/KER - Ad Hoc Summary Driver ; 09/21/2001

 ;;2.7;Health Summary;**6,27,28,30,31,35,47**;Oct 20, 1995

 ;

 ; External References

 ;   DBIA 10060  ^VA(200

 ;   DBIA  2160  ^XUTL("OR")

 ;   DBIA 10141  $$VERSION^XPDUTL

 ;   DBIA   148  PATIENT^ORU1

 ;   DBIA    82  EN^XQORM

 ;   DBIA 10026  ^DIR

 ;   DBIA 10102  DISP^XQORM1

 ;                          

MAIN ; Ad Hoc Summary Driver

 N I,XQORSPEW,%T S DIC=142,DIC(0)="MZF",X="GMTS HS ADHOC OPTION",Y=$$TYPE^GMTSULT K DIC Q:+Y'>0  S GMTSTYP=+Y,GMTSTITL="AD HOC"

 F  D  Q:$D(DUOUT)!$D(DIROUT)!'$D(GMTSEG)

 . K GMTSEG,GMTSEGI,GMTSEGC D BUILD Q:$D(DUOUT)!$D(DIROUT)!'$D(GMTSEG)

 . N GMPAT,GMP F  Q:$D(DIROUT)  D  Q:$D(DUOUT)!$D(DIROUT)!(+$D(GMPAT)'>0)!+$G(ORVP)

 . . K GMP,GMPAT

 . . I +$G(ORVP) S GMPAT(1)=+ORVP

 . . E  F  Q:$D(DIROUT)  K ^XUTL("OR",$J,"ORU"),^("ORV"),^("ORW"),^("ORLP"),GMP D PTPC Q:$S($D(DUOUT):1,$D(DIROUT):1,'+$G(GMP):1,$P($G(^VA(200,DUZ,100.1)),U,6)]"":1,1:0)  D

 . . . W !!,"Another patient(s) can be selected."

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

 . . D RESUB^GMTSDVR(.GMPAT) S ZTRTN="PQ^GMTSADHC" W !

 . . D HSOUT^GMTSDVR

 K ^XUTL("OR",$J,"ORU"),^("ORV"),^("ORW"),^("ORLP")

 Q

PTPC ; Combined Patient/Patient Copy

 N GMTSPRO,GMTSVER S GMTSVER=+($$VERSION^XPDUTL("OR")),GMTSPRO=+($$PROK^GMTSU("ORU1",11))

 D:GMTSVER>2.9&(GMTSPRO) PATIENT^ORU1(.GMP,,"I  $P($G(^(""OOS"")),""^"")")

 D:GMTSVER'>2.9!('GMTSPRO) PATIENT^ORU1(.GMP) D PATCOPY^GMTSDVR(.GMP,.GMPAT)

 Q

PQ ; Queued subroutine to print Ad Hoc HS for each patient

 N GMTS,GMTS1,GMTS2,GMTSAGE,GMTSDOB,GMTSDTM,GMTSLO,GMTSLPG,GMTSPHDR,GMTSPNM,GMTSRB,GMTSSN,GMTSTOF,GMTSWARD,VADM,VAERR,VAIN,VAROOT

 S GMPAT=0 F  S GMPAT=$O(GMPAT(GMPAT)) Q:GMPAT'>0  D  Q:$D(GMTSQIT)!$D(DIROUT)

 . S DFN=+$G(GMPAT(GMPAT)) D EN^GMTS1

 Q

BUILD ; Conducts Dialogue to build ad hoc summary

 N GMI,GMJ,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 GMTSQIT="" Q

 I +Y,(X?1"^^".E) G BUILD

 S GMTSEGC=Y

 S (X,GMI,GMJ)=0 F  S GMI=$O(Y(GMI)) Q:'GMI  D LOAD

 D GETLIM^GMTSADH1

 Q

LOAD ; Load enabled components

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

LOAD1 ; Load GMTSEG and GMTSEGI arrays

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

 Q

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

 N SR,SF,S2,SEL S S2=0 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(GMI,SF,0)=SR

 Q

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

 Q

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 !

 Q

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 ---GMTSADHC   4054     printed  Mar 13, 2025@21:01:40                                                                                                                                                                                                    Page 2

GMTSADHC  ; SLC/KER - Ad Hoc Summary Driver ; 09/21/2001

 +1       ;;2.7;Health Summary;**6,27,28,30,31,35,47**;Oct 20, 1995

 +2       ;

 +3       ; External References

 +4       ;   DBIA 10060  ^VA(200

 +5       ;   DBIA  2160  ^XUTL("OR")

 +6       ;   DBIA 10141  $$VERSION^XPDUTL

 +7       ;   DBIA   148  PATIENT^ORU1

 +8       ;   DBIA    82  EN^XQORM

 +9       ;   DBIA 10026  ^DIR

 +10      ;   DBIA 10102  DISP^XQORM1

 +11      ;                          

MAIN      ; Ad Hoc Summary Driver

 +1        NEW I,XQORSPEW,%T

           SET DIC=142

           SET DIC(0)="MZF"

           SET X="GMTS HS ADHOC OPTION"

           SET Y=$$TYPE^GMTSULT

           KILL DIC

           if +Y'>0

               QUIT 

           SET GMTSTYP=+Y

           SET GMTSTITL="AD HOC"

 +2        FOR 

               Begin DoDot:1

 +3                KILL GMTSEG,GMTSEGI,GMTSEGC

                   DO BUILD

                   if $DATA(DUOUT)!$DATA(DIROUT)!'$DATA(GMTSEG)

                       QUIT 

 +4                NEW GMPAT,GMP

                   FOR 

                       if $DATA(DIROUT)

                           QUIT 

                       Begin DoDot:2

 +5                        KILL GMP,GMPAT

 +6                        IF +$GET(ORVP)

                               SET GMPAT(1)=+ORVP

 +7                       IF '$TEST

                               FOR 

                                   if $DATA(DIROUT)

                                       QUIT 

                                   KILL ^XUTL("OR",$JOB,"ORU"),^("ORV"),^("ORW"),^("ORLP"),GMP

                                   DO PTPC

                                   if $SELECT($DATA(DUOUT)

                                       QUIT 

                                   Begin DoDot:3

 +8                                    WRITE !!,"Another patient(s) can be selected."

                                   End DoDot:3

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

                               QUIT 

 +10                       DO RESUB^GMTSDVR(.GMPAT)

                           SET ZTRTN="PQ^GMTSADHC"

                           WRITE !

 +11                       DO HSOUT^GMTSDVR

                       End DoDot:2

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

                           QUIT 

               End DoDot:1

               if $DATA(DUOUT)!$DATA(DIROUT)!'$DATA(GMTSEG)

                   QUIT 

 +12       KILL ^XUTL("OR",$JOB,"ORU"),^("ORV"),^("ORW"),^("ORLP")

 +13       QUIT 

PTPC      ; Combined Patient/Patient Copy

 +1        NEW GMTSPRO,GMTSVER

           SET GMTSVER=+($$VERSION^XPDUTL("OR"))

           SET GMTSPRO=+($$PROK^GMTSU("ORU1",11))

 +2        if GMTSVER>2.9&(GMTSPRO)

               DO PATIENT^ORU1(.GMP,,"I  $P($G(^(""OOS"")),""^"")")

 +3        if GMTSVER'>2.9!('GMTSPRO)

               DO PATIENT^ORU1(.GMP)

           DO PATCOPY^GMTSDVR(.GMP,.GMPAT)

 +4        QUIT 

PQ        ; Queued subroutine to print Ad Hoc HS for each patient

 +1        NEW GMTS,GMTS1,GMTS2,GMTSAGE,GMTSDOB,GMTSDTM,GMTSLO,GMTSLPG,GMTSPHDR,GMTSPNM,GMTSRB,GMTSSN,GMTSTOF,GMTSWARD,VADM,VAERR,VAIN,VAROOT

 +2        SET GMPAT=0

           FOR 

               SET GMPAT=$ORDER(GMPAT(GMPAT))

               if GMPAT'>0

                   QUIT 

               Begin DoDot:1

 +3                SET DFN=+$GET(GMPAT(GMPAT))

                   DO EN^GMTS1

               End DoDot:1

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

                   QUIT 

 +4        QUIT 

BUILD     ; Conducts Dialogue to build ad hoc summary

 +1        NEW GMI,GMJ,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 GMTSQIT=""

               QUIT 

 +4        IF +Y

               IF (X?1"^^".E)

                   GOTO BUILD

 +5        SET GMTSEGC=Y

 +6        SET (X,GMI,GMJ)=0

           FOR 

               SET GMI=$ORDER(Y(GMI))

               if 'GMI

                   QUIT 

               DO LOAD

 +7        DO GETLIM^GMTSADH1

 +8        QUIT 

LOAD      ; Load enabled components

 +1        NEW SREC,STRN

           SET STRN=+Y(GMI)

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

LOAD1     ; Load GMTSEG and GMTSEGI arrays

 +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 SR,SF,S2,SEL

           SET S2=0

           FOR 

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

               if 'S2

                   QUIT 

               Begin DoDot:1

 +2                SET SEL=^(S2,0)

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

                   if SR="^"

                       QUIT 

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

                   if +SF=0

                       QUIT 

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

                   SET GMTSEG(GMI,SF,0)=SR

               End DoDot:1

 +5        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 

           WRITE @IOF

 +2        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