GMTSADOR ;SLC/KER - Ad Hoc Summary Driver ; 09/21/2001
;;2.7;Health Summary;**30,35,47**;Oct 20, 1995
;
; External References
; DBIA 10026 ^DIR
; DBIA 10140 EN^XQORM
; DBIA 10102 DISP^XQORM1
;
MAIN ; External call to allow user to define components and
; defaults through the AD Hoc menu interface and print
; health summaries for a programmer-specified patient
; and device. Called with:
;
; DFN = Patient internal file record number (optional)
; For OE/RR interface sets DFN to Patient DFN in
; the ORVP variable. If not defined a patient
; will be prompted for.
;
N C,GMTSEG,GMTSEGI,GMTSEGC,GMTSQIT,GMTSTYP,GMTSTITL,GMW,X,Y,DIC,DIPGM,I,POP,%,GMTSMULT,DIROUT,DUOUT,DTOUT,ZTRTN
S DIC=142,DIC(0)="MZF",X="GMTS HS ADHOC OPTION" S Y=$$TYPE^GMTSULT K DIC Q:+Y'>0 S GMTSTYP=+Y,GMTSTITL="AD HOC"
I $G(DFN)'>0 S DFN=$S($D(ORVP):$P(ORVP,";"),1:"") D:+DFN'>0 SELPT^GMTS
Q:+($G(DFN))'>0 F K GMTSEG,GMTSEGI,GMTSEGC D BUILD Q:$D(GMTSQIT)!($D(DIROUT)) D HSOUT^GMTS,END^GMTS S:$D(DTOUT) GMTSQIT="" Q:$D(GMTSQIT)!($D(DIROUT))
D END
Q
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)'=""Y"")"
S XQORM=GMTSTYP_";GMT(142,",XQORM(0)="DA",XQORM("A")="Select COMPONENT(S): ",XQORM("??")="D HELP^GMTSADH" D EN^XQORM I Y'>0 S GMTSQIT="" 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
Q
LOAD ; Load enabled components
N SREC,STRN S STRN=+Y(GMI),SREC=^GMT(142,GMTSTYP,1,STRN,0)
LOAD1 ; Load array GMTSEG
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 S2,SEL,SR,SF 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(GMJ,SF,0)=SR
Q
END ; Cleans up any residual locals
K GMTSQIT,FROM,GMI,I1,ISVALID,LRDFN,PTR,SEX,TO,VAOA,VASD,VASV,X 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 "?"
;; 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".
;;
;;ZZZZ
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSADOR 3230 printed Sep 23, 2025@19:33:07 Page 2
GMTSADOR ;SLC/KER - Ad Hoc Summary Driver ; 09/21/2001
+1 ;;2.7;Health Summary;**30,35,47**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 10026 ^DIR
+5 ; DBIA 10140 EN^XQORM
+6 ; DBIA 10102 DISP^XQORM1
+7 ;
MAIN ; External call to allow user to define components and
+1 ; defaults through the AD Hoc menu interface and print
+2 ; health summaries for a programmer-specified patient
+3 ; and device. Called with:
+4 ;
+5 ; DFN = Patient internal file record number (optional)
+6 ; For OE/RR interface sets DFN to Patient DFN in
+7 ; the ORVP variable. If not defined a patient
+8 ; will be prompted for.
+9 ;
+10 NEW C,GMTSEG,GMTSEGI,GMTSEGC,GMTSQIT,GMTSTYP,GMTSTITL,GMW,X,Y,DIC,DIPGM,I,POP,%,GMTSMULT,DIROUT,DUOUT,DTOUT,ZTRTN
+11 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"
+12 IF $GET(DFN)'>0
SET DFN=$SELECT($DATA(ORVP):$PIECE(ORVP,";"),1:"")
if +DFN'>0
DO SELPT^GMTS
+13 if +($GET(DFN))'>0
QUIT
FOR
KILL GMTSEG,GMTSEGI,GMTSEGC
DO BUILD
if $DATA(GMTSQIT)!($DATA(DIROUT))
QUIT
DO HSOUT^GMTS
DO END^GMTS
if $DATA(DTOUT)
SET GMTSQIT=""
if $DATA(GMTSQIT)!($DATA(DIROUT))
QUIT
+14 DO END
+15 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)'=""Y"")"
+3 SET XQORM=GMTSTYP_";GMT(142,"
SET XQORM(0)="DA"
SET XQORM("A")="Select COMPONENT(S): "
SET XQORM("??")="D HELP^GMTSADH"
DO EN^XQORM
IF Y'>0
SET GMTSQIT=""
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
+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,SEL,SR,SF
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(GMJ,SF,0)=SR
End DoDot:1
+5 QUIT
END ; Cleans up any residual locals
+1 KILL GMTSQIT,FROM,GMI,I1,ISVALID,LRDFN,PTR,SEX,TO,VAOA,VASD,VASV,X
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 "?"
+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 ;;ZZZZ
