source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSADHC.m@ 1671

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1GMTSADHC ; SLC/KER - Ad Hoc Summary Driver ; 09/21/2001
2 ;;2.7;Health Summary;**6,27,28,30,31,35,47**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 10060 ^VA(200
6 ; DBIA 2160 ^XUTL("OR")
7 ; DBIA 10141 $$VERSION^XPDUTL
8 ; DBIA 148 PATIENT^ORU1
9 ; DBIA 82 EN^XQORM
10 ; DBIA 10026 ^DIR
11 ; DBIA 10102 DISP^XQORM1
12 ;
13MAIN ; Ad Hoc Summary Driver
14 N I,XQORSPEW,%T S DIC=142,DIC(0)="MZF",X="GMTS HS ADHOC OPTION",Y=$$TYPE^GMTSULT K DIC Q:+Y'>0 S GMTSTYP=+Y,GMTSTITL="AD HOC"
15 F D Q:$D(DUOUT)!$D(DIROUT)!'$D(GMTSEG)
16 . K GMTSEG,GMTSEGI,GMTSEGC D BUILD Q:$D(DUOUT)!$D(DIROUT)!'$D(GMTSEG)
17 . N GMPAT,GMP F Q:$D(DIROUT) D Q:$D(DUOUT)!$D(DIROUT)!(+$D(GMPAT)'>0)!+$G(ORVP)
18 . . K GMP,GMPAT
19 . . I +$G(ORVP) S GMPAT(1)=+ORVP
20 . . E F Q:$D(DIROUT) K ^XUTL("OR",$J,"ORU"),^("ORV"),^("ORW"),^("ORLP"),GMP D PTPC Q:$S($D(DUOUT):1,$D(DIROUT):1,'+$G(GMP):1,$P($G(^VA(200,DUZ,100.1)),U,6)]"":1,1:0) D
21 . . . W !!,"Another patient(s) can be selected."
22 . . Q:$D(DUOUT)!$D(DIROUT)!(+$D(GMPAT)'>0)
23 . . D RESUB^GMTSDVR(.GMPAT) S ZTRTN="PQ^GMTSADHC" W !
24 . . D HSOUT^GMTSDVR
25 K ^XUTL("OR",$J,"ORU"),^("ORV"),^("ORW"),^("ORLP")
26 Q
27PTPC ; Combined Patient/Patient Copy
28 N GMTSPRO,GMTSVER S GMTSVER=+($$VERSION^XPDUTL("OR")),GMTSPRO=+($$PROK^GMTSU("ORU1",11))
29 D:GMTSVER>2.9&(GMTSPRO) PATIENT^ORU1(.GMP,,"I $P($G(^(""OOS"")),""^"")")
30 D:GMTSVER'>2.9!('GMTSPRO) PATIENT^ORU1(.GMP) D PATCOPY^GMTSDVR(.GMP,.GMPAT)
31 Q
32PQ ; Queued subroutine to print Ad Hoc HS for each patient
33 N GMTS,GMTS1,GMTS2,GMTSAGE,GMTSDOB,GMTSDTM,GMTSLO,GMTSLPG,GMTSPHDR,GMTSPNM,GMTSRB,GMTSSN,GMTSTOF,GMTSWARD,VADM,VAERR,VAIN,VAROOT
34 S GMPAT=0 F S GMPAT=$O(GMPAT(GMPAT)) Q:GMPAT'>0 D Q:$D(GMTSQIT)!$D(DIROUT)
35 . S DFN=+$G(GMPAT(GMPAT)) D EN^GMTS1
36 Q
37BUILD ; Conducts Dialogue to build ad hoc summary
38 N GMI,GMJ,X,XQORM,Y Q:$D(GMTSQIT)!($D(DIROUT)) W @IOF
39 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
40 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 GMTSQIT="" Q
41 I +Y,(X?1"^^".E) G BUILD
42 S GMTSEGC=Y
43 S (X,GMI,GMJ)=0 F S GMI=$O(Y(GMI)) Q:'GMI D LOAD
44 D GETLIM^GMTSADH1
45 Q
46LOAD ; Load enabled components
47 N SREC,STRN S STRN=+Y(GMI),SREC=^GMT(142,GMTSTYP,1,STRN,0)
48LOAD1 ; Load GMTSEG and GMTSEGI arrays
49 S GMJ=GMJ+1,GMTSEG(GMJ)=SREC,GMTSEGI($P(SREC,U,2))=GMJ D LOADSEL
50 Q
51LOADSEL ; Loads GMTSEG(J,FN,IFN) (Selection Items)
52 N SR,SF,S2,SEL S S2=0 F S S2=$O(^GMT(142,GMTSTYP,1,STRN,1,S2)) Q:'S2 D
53 . S SEL=^(S2,0),SR=U_$P(SEL,";",2) Q:SR="^"
54 . S SF=+$P(@(SR_"0)"),U,2) Q:+SF=0
55 . S GMTSEG(GMJ,SF,S2)=$P(SEL,";"),GMTSEG(GMI,SF,0)=SR
56 Q
57HELP ; Display Help Text
58 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)
59 I X="???" W !! D HELP2^GMTSUP1
60 D REDISP
61 Q
62REDISP ; Ask Whether or not to redisplay menu
63 N I,DIR,X,Y S DIR(0)="Y",DIR("A")="Redisplay items",DIR("B")="YES" D ^DIR Q:'Y W @IOF
64 D DISP^XQORM1 W !
65 Q
66HTX1 ; Help Text for "?" and "??"
67 ;;Select ONE or MORE items from the menu, separated by commas.
68 ;;
69 ;;Enter: ?? to see HELP for MULTIPLE SELECTION
70 ;; ??? to see HELP for "^^"-jump
71 ;;
72 ;;ZZZZ
73HTX2 ; Help Text for ??
74 ;;
75 ;;The Health Summary components you select at this prompt create
76 ;;an ADHOC Health Summary.
77 ;;
78 ;;Select ONE or MORE items from the menu, separated by commas.
79 ;;
80 ;;ALL items may be selected by typing "ALL".
81 ;;
82 ;;EXCEPTIONS may be entered by preceding them with a minus.
83 ;; For example, "ALL,-THIS,-THAT" selects all but "THIS" and "THAT".
84 ;;
85 ;;NOTE: Menu items are ordered alphabetically by the Component NAME.
86 ;; However, the displayed text is the Header Name which generally
87 ;; is different from the Component Name. Component may be picked
88 ;; by their abbreviation, Header Name or Component Name.
89 ;;
90 ;;ZZZZ
Note: See TracBrowser for help on using the repository browser.