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