source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSADH.m@ 1046

Last change on this file since 1046 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.4 KB
RevLine 
[613]1GMTSADH ;SLC/JER,MAM - Ad Hoc Summary Driver ; 09/21/2001
2 ;;2.7;Health Summary;**30,35,47**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 10035 ^DPT(
6 ; DBIA 148 PATIENT^ORU1
7 ; DBIA 10141 $$VERSION^XPDUTL
8 ; DBIA 82 EN^XQORM
9 ; DBIA 10026 ^DIR
10 ; DBIA 10102 DISP^XQORM1
11 ;
12MAIN ; Ad Hoc Health Summary Driver
13 N C,DFN,GMTSEG,GMTSEGI,GMTSEGC,GMTSQIT,GMTSTYP,GMTSTITL,GMW,X,Y,DIC,DIPGM,I,POP,%,DIROUT,DUOUT,DTOUT,ZTRTN,GMTSQIT,FROM,GMI,I1,ISVALID,LRDFN,PTR,SEX,TO,VAOA,VASD,VASV
14 I $L($T(PATIENT^ORU1)),($$VERSION^XPDUTL("OR")>2.19) D MAIN^GMTSADHC Q
15 S DIC=142,DIC(0)="MZF",X="GMTS HS ADHOC OPTION",Y=$$TYPE^GMTSULT K DIC S GMTSTYP=+Y,GMTSTITL="AD HOC"
16 F K GMTSEG,GMTSEGI,GMTSEGC D BUILD D Q:$D(DIROUT)!$D(DUOUT)!$D(DTOUT)
17 . N GMPAT,DFN,GMTSMULT F D Q:$D(DIROUT)!$D(DUOUT)!$D(DTOUT)!(+$D(GMPAT)'>0)
18 . . Q:$D(DIROUT)!$D(DUOUT)!$D(DTOUT)
19 . . K GMPAT,GMTSMULT F Q:$D(DIROUT) K DFN W ! D SELPT^GMTS Q:+($G(DFN))'>0 D
20 . . . N GMNAME S GMNAME=$P($G(^DPT(+DFN,0)),U) Q:GMNAME="" S GMPAT(GMNAME,+($G(DFN)))=+($G(DFN))
21 . . Q:$D(DIROUT)!$D(DUOUT)!$D(DTOUT)!(+$D(GMPAT)'>0)
22 . . D RESUB^GMTSDVR(.GMPAT) S ZTRTN="PQ^GMTS" N DUOUT D HSOUT^GMTSDVR,END^GMTS W !
23 Q
24BUILD ; Conducts Dialogue to build Ad Hoc Summary
25 N GMI,GMJ,GMW,X,XQORM,Y Q:$D(GMTSQIT)!($D(DIROUT)) W @IOF
26 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
27 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 DIROUT=1 Q
28 G:+Y&(X?1"^^".E) BUILD S GMTSEGC=Y,(X,GMI,GMJ)=0 F S GMI=$O(Y(GMI)) Q:'GMI D LOAD
29 D GETLIM^GMTSADH1
30 Q
31LOAD ; Load enabled components
32 N SREC,STRN S STRN=+Y(GMI),SREC=^GMT(142,GMTSTYP,1,STRN,0)
33LOAD1 ; Load array GMTSEG and GMTSEGI
34 S GMJ=GMJ+1,GMTSEG(GMJ)=SREC,GMTSEGI($P(SREC,U,2))=GMJ D LOADSEL
35 Q
36LOADSEL ; Loads GMTSEG(J,FN,IFN) (Selection Items)
37 N S2,SJ,SEL,SR,SF S S2=0,SJ=GMJ
38 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
43HELP ; Display Help Text
44 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)
45 I X="???" W !! D HELP2^GMTSUP1
46 D REDISP
47 Q
48REDISP ; Ask Whether or not to redisplay menu
49 N I,DIR,X,Y S DIR(0)="Y",DIR("A")="Redisplay items",DIR("B")="YES" D ^DIR Q:'Y
50 W @IOF D DISP^XQORM1 W !
51 Q
52HTX1 ;; Help Text for "?" and "??"
53 ;; Select ONE or MORE items from the menu, separated by commas.
54 ;;
55 ;; Enter: ?? to see HELP for MULTIPLE SELECTION
56 ;; ??? to see HELP for "^^"-jump
57 ;;
58 ;;ZZZZ
59HTX2 ;; Help Text for ??
60 ;;
61 ;; The Health Summary components you select at this prompt create
62 ;; an ADHOC Health Summary.
63 ;;
64 ;; Select ONE or MORE items from the menu, separated by commas.
65 ;;
66 ;; ALL items may be selected by typing "ALL".
67 ;;
68 ;; EXCEPTIONS may be entered by preceding them with a minus.
69 ;; For example, "ALL,-THIS,-THAT" selects all but "THIS" and "THAT".
70 ;;
71 ;; NOTE: Menu items are ordered alphabetically by the Component NAME.
72 ;; However, the displayed text is the Header Name which generally
73 ;; is different from the Component Name. Component may be picked
74 ;; by their abbreviation, Header Name or Component Name.
75 ;;
76 ;;ZZZZ
Note: See TracBrowser for help on using the repository browser.