source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSDVR.m@ 1680

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

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1GMTSDVR ; SLC/JER,KER - Health Summary Driver ; 04/30/2002
2 ;;2.7;Health Summary;**6,16,27,28,30,31,35,49,55**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 10090 ^DIC(4
6 ; DBIA 510 ^DISV(
7 ; DBIA 10035 ^DPT(
8 ; DBIA 10091 ^XMB(1
9 ; DBIA 10076 ^XUSEC("GMTS VIEW ONLY"
10 ; DBIA 2160 ^XUTL("OR"
11 ; DBIA 10086 ^%ZIS
12 ; DBIA 10089 ^%ZISC
13 ; DBIA 10063 ^%ZTLOAD
14 ; DBIA 148 PATIENT^ORU1
15 ; DBIA 183 DFN^PSOSD1
16 ; DBIA 10141 $$VERSION^XPDUTL
17 ;
18MAIN ; Control branching
19 N C,I,GMTYP,VADM,VAROOT,ZTRTN,GMPSAP
20 K DIROUT,DUOUT
21 F D Q:$D(DUOUT)!$D(DIROUT)!($D(GMTYP)'>9)
22 . D SELTYP Q:$D(DUOUT)!$D(DIROUT)!($D(GMTYP)'>9)
23 . N GMPAT,GMP
24 . F Q:$D(DIROUT) D Q:$D(DUOUT)!$D(DIROUT)!(+$D(GMPAT)'>0)!(+($G(ORVP))>0)
25 . . K GMP,GMPAT
26 . . I +($G(ORVP)) S GMPAT(1)=+($G(ORVP))
27 . . 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,1:0) D
28 . . . W !!,"Another patient(s) can be selected."
29 . . Q:$D(DUOUT)!$D(DIROUT)!(+$D(GMPAT)'>0)
30 . . N GMTSPX1,GMTSPX2
31 . . I +$G(GMRANGE)>0 D GETRANGE^GMTSU(.GMTSPX2,.GMTSPX1) Q:$G(GMTSPX1)=""!($G(GMTSPX2)="")
32 . . Q:$D(DUOUT)!$D(DIROUT)
33 . . D RESUB(.GMPAT)
34 . . S GMPSAP=$$RXAP^GMTSPD2 Q:$D(DIROUT)!$D(DUOUT)!$D(DTOUT)
35 . . S ZTRTN="PQ^GMTSDVR"
36 . . D HSOUT
37 K ^XUTL("OR",$J,"ORU"),^("ORV"),^("ORW"),^("ORLP")
38 Q
39PTPC ; Combined Patient/Patient Copy
40 N GMTSPRO,GMTSVER S GMTSVER=+($$VERSION^XPDUTL("OR")),GMTSPRO=+($$PROK^GMTSU("ORU1",11))
41 D:GMTSVER>2.9&(GMTSPRO) PATIENT^ORU1(.GMP,,"I $P($G(^(""OOS"")),""^"")")
42 D:GMTSVER'>2.9!('GMTSPRO) PATIENT^ORU1(.GMP) D PATCOPY^GMTSDVR(.GMP,.GMPAT)
43 Q
44PATCOPY(GMP,GMPAT) ; Copies patients from GMP to GMPAT array
45 N IFN,GMDFN
46 S IFN=0
47 ; GMPAT(NAME,GMDFN) - alphabetic order by patient
48 F S IFN=$O(GMP(IFN)) Q:IFN'>0 D
49 . S GMDFN=+$G(GMP(IFN))
50 . ; Get name from ^DPT to prevent duplicates
51 . S GMPAT($P($G(^DPT(GMDFN,0)),U),+GMDFN)=+GMDFN
52 Q
53RESUB(GMP) ; Resubscript GMP Array
54 ; Subscripts in GMP array are converted to numeric
55 N NAME,GMDFN,CNT
56 S CNT=0,NAME=""
57 F S NAME=$O(GMP(NAME)) Q:NAME']"" D
58 . S GMDFN=0
59 . F S GMDFN=$O(GMP(NAME,GMDFN)) Q:GMDFN'>0 D
60 . . S CNT=CNT+1
61 . . S GMP(CNT)=GMP(NAME,GMDFN)
62 . . K GMP(NAME,GMDFN)
63 Q
64 ;
65ENXQ ; External call for tasked HS print
66 ;
67 ; Input: GMTSTYP=Record # of HS type in file 142
68 ; DFN=Record # of patient in file 2
69 ; GMTSPX1=Optional internal FM ending date
70 ; GMTSPX2=Optional internal FM beginning date
71 ;
72 ; NOTE: Optional date range variables are both
73 ; required if a date range is desired.
74 ;
75 ; To call from TaskMan:
76 ; S ZTRTN="ENXQ^GMTSDVR"
77 ; S ZTSAVE("GMTSTYP")=""
78 ; S ZTSAVE("DFN")=""
79 ; D ^%ZTLOAD
80 D ENX(DFN,GMTSTYP,$G(GMTSPX2),$G(GMTSPX1))
81 Q
82 ;
83ENX(DFN,GMTSTYP,GMTSPX2,GMTSPX1) ; External call to print a Health Summary
84 ;
85 ; Input: GMTSTYP=Record # of HS type in file 142
86 ; DFN=Record # of patient in file 2
87 ; GMTSPX1=Optional internal FM ending date
88 ; GMTSPX2=Optional internal FM beginning date
89 ;
90 ; NOTE: Optional date range variables are both
91 ; required if a date range is desired.
92 ;
93 N DI,DX,DY,GMQUIT,GMTYP,GMPAT,VADM,VAIN,VAROOT
94 F Q:($D(^GMT(142,+GMTSTYP,1))>9)&$D(^DPT(DFN))!+$G(GMQUIT) D
95 . I $D(^GMT(142,+GMTSTYP,1))'>9 D
96 . . I $D(ZTQUEUED) S GMQUIT=1 Q
97 . . W !?3,"Invalid HEALTH SUMMARY TYPE." D SELTYP S GMTSTYP=+$G(GMTYP(1))
98 . I '$D(^DPT(DFN)) D
99 . . I $D(ZTQUEUED) S GMQUIT=1 Q
100 . . W !?3,"Invalid PATIENT ID." D PATIENT^ORU1(.GMPAT) S DFN=+$G(GMPAT(1))
101 Q:+$G(GMQUIT)
102 S:$D(GMTYP)'>9 GMTYP(0)=1,GMTYP(1)=+$G(GMTSTYP)_U_$P($G(^GMT(142,+GMTSTYP,0)),U)
103 S:$D(GMPAT)'>9 GMPAT=1,GMPAT(0)=1,GMPAT(1)=DFN_U_$P($G(^DPT(DFN,0)),U)
104 D PQ
105 Q
106SELTYP ; Select Health Summary Type(s)
107 N DIC,X,Y
108 S DIC=142,DIC("A")="Select Health Summary Type: ",DIC(0)="AEMQZ"
109 S DIC("S")="I $P(^(0),U)'=""GMTS HS ADHOC OPTION"""
110 I $D(GMTYP)<10 S DIC("B")=$S($D(^DISV(DUZ,"^GMT(142,"))=10:$G(^DISV(DUZ,"^GMT(142,",$O(^("^GMT(142,",0)))),1:$P($G(^GMT(142,+$G(^DISV(DUZ,"^GMT(142,")),0)),U))
111 K GMTYP S Y=$$TYPE^GMTSULT Q:+Y'>0
112 I $S($D(^GMT(142,+Y,1,0))=0:1,$O(^(0))'>0:1,1:0) W !,"The Summary Type "_$P(Y,U,2)_" includes no components...Please choose another",! Q
113 S GMTYP(0)=1,GMTYP(1)=Y_U_$P(Y,U,2)_U_$P(Y,U,2)_U_$P(Y,U,2)
114 Q
115PQ ; Queued subroutine for HS by patient
116 N DFN,GMTI,GMTS,GMTS1,GMTS2,GMTSAGE,GMTSDOB,GMTSDTM,GMTSLO,GMTSLPG,GMTSPNM
117 N GMTSRB,GMTSSN,GMTSTOF,GMTSTYP,GMTSTITL,GMTSWARD,GMTJ,I,IX0,J,M4,P17,SEX
118 N GMTSPHDR,TRFAC,VAERR,VAIN
119 S GMTI=0 F S GMTI=$O(GMTYP(GMTI)) Q:GMTI'>0!$D(DIROUT) D
120 . N GMTSEG,GMTSEGC,GMTSEGI
121 . S GMTSTYP=+$G(GMTYP(GMTI)),GMTSTITL=$G(^GMT(142,+GMTSTYP,"T"))
122 . S:'$L(GMTSTITL) GMTSTITL=$P(GMTYP(GMTI),U,2)
123 . D LOADSEG
124 . S GMTJ=0 F S GMTJ=$O(GMPAT(GMTJ)) Q:GMTJ'>0!$D(DIROUT) D
125 . . S DFN=+$G(GMPAT(GMTJ))
126 . . N GMDUOUT
127 . . D EN^GMTS1
128 . . Q:$D(DIROUT)!+$G(GMDUOUT)
129 . . D ACTPROF^GMTSDVR(DFN)
130 Q
131LOADSEG ; Load Enabled Components into GMTSEG Array
132 N GMTI,GMTJ,GMX
133 S (GMTI,GMTJ)=0 F S GMTJ=$O(^GMT(142,GMTSTYP,1,GMTJ)) Q:GMTJ'>0 S GMX=^(GMTJ,0) D
134 .S GMTI=GMTI+1,GMTSEG(GMTI)=GMX,GMTSEGI($P(GMX,U,2))=GMTI D SELFILE
135 S GMTSEGC=GMTI
136 Q
137SELFILE ; Get Selection item information for GMTSEG(
138 N GMTK S GMTK=0 F S GMTK=$O(^GMT(142,GMTSTYP,1,GMTJ,1,GMTK)) Q:GMTK'>0 D
139 . N GMTSE,GMTSR,GMTSF S GMTSE=^(GMTK,0),GMTSR=U_$P(GMTSE,";",2) Q:GMTSR="^"
140 . S GMTSF=+$P(@(GMTSR_"0)"),U,2) Q:+GMTSF=0
141 . S GMTSEG(GMTI,GMTSF,GMTK)=$P(GMTSE,";"),GMTSEG(GMTI,GMTSF,0)=GMTSR
142 Q
143HSOUT ; Output summary, with device control
144 ; Call with: ZTRTN
145 I $D(^XUSEC("GMTS VIEW ONLY",DUZ)) D @ZTRTN Q
146 N %ZIS,IOP
147 S %ZIS="PQ" D ^%ZIS Q:POP
148 G:$D(IO("Q")) QUE
149NOQUE ; Do Not Queue Output
150 D @ZTRTN D ^%ZISC
151 Q
152QUE ; Queue output
153 N %,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
154 Q:'$D(ZTRTN) K IO("Q"),ZTSAVE F %="DFN","GM*","ENTRY","O*" S ZTSAVE(%)=""
155 S ZTDESC="HEALTH SUMMARY",ZTIO=ION
156 D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!")
157 K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE D ^%ZISC
158 S IOP="HOME" D ^%ZIS
159 Q
160ACTPROF(GMDFN) ; Print Action Profile for Patient
161 N DFN,PSTYPE,PSONOPG,PSOPAR,PSOINST
162 I +$G(GMPSAP) D
163 . S (PSTYPE,PSONOPG)=1,DFN=GMDFN
164 . S $P(PSOPAR,U)=$S($P($G(^GMT(142.99,1,0)),U,5)="Y":1,1:0)
165 . S PSOINST=$S(+$G(PSOINST):PSOINST,1:+$P($G(^DIC(4,+$P($G(^XMB(1,1,"XUS")),U,17),99)),U))
166 . D DFN^PSOSD1
167 . S DFN=GMDFN
168 . ; Reset DFN because ^PSOSD1 call kills it
169 . D PAGE^GMTSPL
Note: See TracBrowser for help on using the repository browser.