1 | GMTSADOR ;SLC/KER - Ad Hoc Summary Driver ; 09/21/2001
|
---|
2 | ;;2.7;Health Summary;**30,35,47**;Oct 20, 1995
|
---|
3 | ;
|
---|
4 | ; External References
|
---|
5 | ; DBIA 10026 ^DIR
|
---|
6 | ; DBIA 10140 EN^XQORM
|
---|
7 | ; DBIA 10102 DISP^XQORM1
|
---|
8 | ;
|
---|
9 | MAIN ; External call to allow user to define components and
|
---|
10 | ; defaults through the AD Hoc menu interface and print
|
---|
11 | ; health summaries for a programmer-specified patient
|
---|
12 | ; and device. Called with:
|
---|
13 | ;
|
---|
14 | ; DFN = Patient internal file record number (optional)
|
---|
15 | ; For OE/RR interface sets DFN to Patient DFN in
|
---|
16 | ; the ORVP variable. If not defined a patient
|
---|
17 | ; will be prompted for.
|
---|
18 | ;
|
---|
19 | N C,GMTSEG,GMTSEGI,GMTSEGC,GMTSQIT,GMTSTYP,GMTSTITL,GMW,X,Y,DIC,DIPGM,I,POP,%,GMTSMULT,DIROUT,DUOUT,DTOUT,ZTRTN
|
---|
20 | 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"
|
---|
21 | I $G(DFN)'>0 S DFN=$S($D(ORVP):$P(ORVP,";"),1:"") D:+DFN'>0 SELPT^GMTS
|
---|
22 | 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))
|
---|
23 | D END
|
---|
24 | Q
|
---|
25 | BUILD ; Conducts Dialogue to build Ad Hoc Summary
|
---|
26 | N GMI,GMJ,GMW,X,XQORM,Y Q:$D(GMTSQIT)!($D(DIROUT)) W @IOF
|
---|
27 | 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"")"
|
---|
28 | 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
|
---|
29 | G:+Y&(X?1"^^".E) BUILD S GMTSEGC=Y,(X,GMI,GMJ)=0 F S GMI=$O(Y(GMI)) Q:'GMI D LOAD
|
---|
30 | D GETLIM^GMTSADH1
|
---|
31 | Q
|
---|
32 | LOAD ; Load enabled components
|
---|
33 | N SREC,STRN S STRN=+Y(GMI),SREC=^GMT(142,GMTSTYP,1,STRN,0)
|
---|
34 | LOAD1 ; Load array GMTSEG
|
---|
35 | S GMJ=GMJ+1,GMTSEG(GMJ)=SREC,GMTSEGI($P(SREC,U,2))=GMJ D LOADSEL
|
---|
36 | Q
|
---|
37 | LOADSEL ; Loads GMTSEG(J,FN,IFN) (Selection Items)
|
---|
38 | N S2,SEL,SR,SF S S2=0 F S S2=$O(^GMT(142,GMTSTYP,1,STRN,1,S2)) Q:'S2 D
|
---|
39 | . S SEL=^(S2,0),SR=U_$P(SEL,";",2) Q:SR="^"
|
---|
40 | . S SF=+$P(@(SR_"0)"),U,2) Q:+SF=0
|
---|
41 | . S GMTSEG(GMJ,SF,S2)=$P(SEL,";"),GMTSEG(GMJ,SF,0)=SR
|
---|
42 | Q
|
---|
43 | END ; Cleans up any residual locals
|
---|
44 | K GMTSQIT,FROM,GMI,I1,ISVALID,LRDFN,PTR,SEX,TO,VAOA,VASD,VASV,X Q
|
---|
45 | HELP ; Display Help Text
|
---|
46 | 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)
|
---|
47 | I X="???" W !! D HELP2^GMTSUP1
|
---|
48 | D REDISP
|
---|
49 | Q
|
---|
50 | REDISP ; Ask Whether or not to redisplay menu
|
---|
51 | N I,DIR,X,Y S DIR(0)="Y",DIR("A")="Redisplay items",DIR("B")="YES" D ^DIR Q:'Y W @IOF
|
---|
52 | D DISP^XQORM1 W !
|
---|
53 | Q
|
---|
54 | HTX1 ; Help Text for "?"
|
---|
55 | ;; Select ONE or MORE items from the menu, separated by commas.
|
---|
56 | ;;
|
---|
57 | ;; Enter: ?? to see HELP for MULTIPLE SELECTION
|
---|
58 | ;; ??? to see HELP for "^^"-jump
|
---|
59 | ;;
|
---|
60 | ;;ZZZZ
|
---|
61 | HTX2 ; Help Text for ??
|
---|
62 | ;;
|
---|
63 | ;; The Health Summary components you select at this prompt create
|
---|
64 | ;; an ADHOC Health Summary.
|
---|
65 | ;;
|
---|
66 | ;; Select ONE or MORE items from the menu, separated by commas.
|
---|
67 | ;;
|
---|
68 | ;; ALL items may be selected by typing "ALL".
|
---|
69 | ;;
|
---|
70 | ;; EXCEPTIONS may be entered by preceding them with a minus.
|
---|
71 | ;; For example, "ALL,-THIS,-THAT" selects all but "THIS" and "THAT".
|
---|
72 | ;;
|
---|
73 | ;;ZZZZ
|
---|