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