source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXTA.m

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

initial load of WorldVistAEHR

File size: 7.3 KB
Line 
1PXRMXTA ; SLC/PJH - Reminder Reports Template Edit ;06/20/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ; Called from PXRMYD,PXRMXD
5 ;
6 ;Edit selected template or run report
7 ;-------------------------------------
8START(ROUTINE) ;
9 N PXRMASK,PXRMEDIT,PXRMCOPY,MSG,DIC,NLOC
10 N PXRMTREM,PXRMTCAT
11 S PXRMASK="N",PXRMCOPY="N",PXRMEDIT="N"
12 ;Option to edit/copy template
13USE I 'PXRMUSER D ASK(.PXRMASK) Q:$D(DUOUT)!$D(DTOUT)
14 ;Option to edit template
15 I PXRMASK="Y" D Q:$D(DUOUT)!$D(DTOUT)
16 .;Template edit and redisplay
17 .D LOCK Q:$D(DUOUT)
18 .D EDIT^PXRMXTE,UNLOCK
19 .;Rollback changes on exit
20 .I $D(DUOUT)!$D(DTOUT) D Q
21 ..D ROLL^PXRMXTF
22 .;If all the templates have been deleted exit report
23 .I '$$FIND^PXRMXT(PXRMTYP) S DTOUT=1 Q
24 .;Check if template has been deleted
25 .I '$D(DA) S DUOUT=1 Q
26 .;Sort out the filing
27 .D ^PXRMXTF I $D(MSG) S DUOUT=1 Q
28 ;
29CHECK ;Check for missing fields
30 N CNT,CRCNT,NODE,QUIT,RIEN
31 S CNT=0,QUIT=0
32 I PXRMSEL="R" F S CNT=$O(PXRMLIST(CNT)) Q:CNT'>0 D
33 .S NODE=$G(PXRMLIST(CNT))
34 .I $P(^PXRMXP(810.5,$P(NODE,U),30,0),U,3)'>0 S QUIT=1 W !!,"PATIENT LIST: "_$P(NODE,U,2)_"DOES NOT CONTAIN PATIENTS!" Q
35 ;I PXRMSEL="O" F S CNT=$O(PXRMOTM(CNT)) Q:CNT'>0 D
36 ;.S NODE=$G(PXRMOTM(CNT))
37 ;.I $P(^OR(100.21,$P(NODE,U),10,0),U,3)'>0 S QUIT=1 W !!,"OE/RR TEAM: "_$P(NODE,U,2)_"DOES NOT CONTAIN PATIENTS!" Q
38 S CNT=0
39 I $D(PXRMRCAT)>0 F S CNT=$O(PXRMRCAT(CNT)) Q:CNT'>0 D
40 .S NODE=$G(PXRMRCAT(CNT))
41 .S CRCNT=0 F S CRCNT=$O(^PXRMD(811.7,$P(NODE,U),2,CRCNT)) Q:CRCNT'>0 D
42 ..S RIEN=$P($G(^PXRMD(811.7,$P(NODE,U),2,CRCNT,0)),U)
43 ..I $D(^PXD(811.9,RIEN))'>0 S QUIT=1 D
44 ...W !!,"REMINDER CATEGORY: "_$P(NODE,U,2)_" CONTAINS A POINTER TO ONE OR MORE REMINDERS THAT DO"
45 ...W !,"NOT EXIST ON THE SYSTEM!" Q
46 I QUIT=1,'PXRMUSER W !!,"THE TEMPLATE NEEDS TO BE EDITED." H 2 G USE
47 I QUIT=1,PXRMUSER W !!,"HAVE THE REMINDERS CLINICAL APPLICATION COORDINATOR CORRECT THE TEMPLATE." H 2 Q
48 ;
49FAC ;Option to combine multifacility report
50 I "IRPO"'[PXRMSEL,NFAC>1 D Q:$D(DTOUT) I $D(DUOUT) Q:PXRMUSER G USE
51 .D COMB^PXRMXSD(.PXRMFCMB,"Facilities","N")
52 ;
53 ;Date range input (location only)
54DAT I PXRMSEL="L" D Q:$D(DTOUT) I $D(DUOUT) Q:PXRMUSER G USE
55 .I PXRMFD="P" D PDR^PXRMXDUT(.PXRMBDT,.PXRMEDT,"ENCOUNTER")
56 .I PXRMFD="F" D FDR^PXRMXDUT(.PXRMBDT,.PXRMEDT,"APPOINTMENT")
57 .I PXRMFD="A" D PDR^PXRMXDUT(.PXRMBDT,.PXRMEDT,"ADMISSION")
58 .I PXRMFD="C" S PXRMBDT=DT,PXRMEDT=DT
59 ;Due Effective Date
60EFF D SDR^PXRMXDUT(.PXRMSDT) Q:$D(DTOUT)
61 I $D(DUOUT) G:PXRMSEL="L" DAT Q:PXRMUSER G USE
62 ;
63 ;Check if combined location report is required
64LCOMB S NLOC=0
65 I PXRMREP="D",PXRMSEL="L" D G:$D(DTOUT) EXIT G:$D(DUOUT) EFF
66 .N DEFAULT,TEXT
67 .D NLOC^PXRMXD
68 .I NLOC>1 D COMB^PXRMXSD(.PXRMLCMB,TEXT,DEFAULT)
69 ;
70 ;Check if combined OE/RR team report is required
71TCOMB S NOTM=0
72 I PXRMREP="D",PXRMSEL="O" D G:$D(DTOUT) EXIT G:$D(DUOUT) EFF
73 .N DEFAULT,TEXT
74 .S NOTM=$O(PXRMOTM(""),-1) I NOTM<2 Q
75 .S DEFAULT="N",TEXT="OE/RR teams"
76 .D COMB^PXRMXSD(.PXRMTCMB,TEXT,DEFAULT)
77 ;
78 ;Reminders Due sort and appointment date options
79APPT I PXRMREP="D" D FUT Q:$D(DTOUT) I $D(DUOUT) G:(PXRMSEL="L")&(NLOC>1) LCOMB G:(PXRMSEL="O")&(NOTM>1) TCOMB G EFF
80 ;
81 ;
82 ;Option to print full SSN
83SSN I PXRMREP="D" D G:$D(DTOUT) EXIT G:$D(DUOUT) APPT
84 .D SSN^PXRMXSD(.PXRMSSN)
85 ;
86 ;Option to print without totals, with totals or totals only
87TOT I PXRMREP="S" D Q:$D(DTOUT) I $D(DUOUT) G EFF
88 .;Default is normal report
89 .S PXRMTOT="I"
90 .;Ignore patient list and individual patient options
91 .I "RI"[PXRMSEL Q
92 .;Only prompt if more than one location, team or provider is selected
93 .I PXRMSEL="P",'$O(PXRMPRV(1)) Q
94 .I PXRMSEL="O",'$O(PXRMOTM(1)) Q
95 .I PXRMSEL="T",'$O(PXRMPCM(1)) Q
96 .;Ignore reports for all locations
97 .I PXRMSEL="L",PXRMLCMB="Y" Q
98 .I PXRMSEL="L" N DEFAULT,TEXT D NLOC^PXRMXD Q:NLOC<2
99 .;Prompt for options
100 .N LIT1,LIT2,LIT3
101 .D LIT^PXRMXD,TOTALS^PXRMXSD(.PXRMTOT,LIT1,LIT2,LIT3)
102 ;
103 ;Option to print delimiter separated output
104TABS D G:$D(DTOUT) EXIT I $D(DUOUT) G:PXRMREP="D" SSN G TOT
105 .D TABS^PXRMXSD(.PXRMTABS)
106 ;
107 ;Select chracter
108TCHAR I PXRMTABS="Y" D G:$D(DTOUT) EXIT G:$D(DUOUT) TABS
109 .S PXRMTABC=$$DELIMSEL^PXRMXSD
110 ;
111DPAT ;Ask whether to include deceased and test patients.
112 S PXRMDPAT=$$ASKYN^PXRMEUT("N","Include deceased patients on the list")
113 N PXRMIDOD I PXRMDPAT>0 S PXRMIDOD=1
114 Q:$D(DTOUT) G:$D(DUOUT) TABS
115TPAT ;
116 S PXRMTPAT=$$ASKYN^PXRMEUT("N","Include test patients on the list")
117 Q:$D(DTOUT) G:$D(DUOUT) DPAT
118PATLIST ;
119 N PATLST,PATCREAT
120 I PXRMSEL'="I"&(PXRMUSER=0) D
121 . D ASK^PXRMXD(.PATLST,"Save due patients to a patient list: ",3)
122 . I $G(PATLST)="" Q
123 . I $G(PATLST)="N" S PXRMLIS1=""
124 . I $G(PATLST)="Y" D
125 . . S PATCREAT="N" D ASK^PXRMXD(.PATCREAT,"Secure list?: ",2)
126 . . Q:$D(DTOUT)!($D(DUOUT))
127 . . K PLISTPUG
128 . . S PLISTPUG="N" D ASK^PXRMXD(.PLISTPUG,"Purge Patient List after 5 years?: ",5)
129 I $G(PATLST)="" G:$D(DTOUT) EXIT I $D(DUOUT) G TPAT
130 G:$D(DTOUT) EXIT I $D(DUOUT) G PATLIST
131 I $G(PATLST)="Y" S TEXT="Select PATIENT LIST name: " D PLIST^PXRMLCR(.PXRMLIS1,TEXT,"") Q:$D(DUOUT)!$D(DTOUT)
132 ;Initiate report
133 D @ROUTINE
134EXIT Q
135 ;
136 ;File locking
137 ;------------
138UNLOCK L -^PXRMPT(810.1,$P(PXRMTMP,U)) Q
139LOCK L +^PXRMPT(810.1,$P(PXRMTMP,U)):0
140 E W !!?5,"Another user is editing this entry" S DUOUT=1
141 Q
142 ;
143 ;Option to use report template
144 ;-----------------------------
145ASK(YESNO) ;
146 N X,Y,TEXT
147 K DIROUT,DIRUT,DTOUT,DUOUT
148 S DIR(0)="YA0"
149 S DIR("A")="WANT TO EDIT '"_$P(PXRMTMP,U,2)_"' TEMPLATE: "
150 S DIR("B")="N"
151 S DIR("?")="Enter Y or N. For detailed help type ??"
152 S DIR("??")=U_"D HELP^PXRMXTA(1)"
153 W !
154 D ^DIR K DIR
155 I $D(DIROUT) S DTOUT=1
156 I $D(DTOUT)!($D(DUOUT)) Q
157 S YESNO=$E(Y(0))
158 Q
159 ;
160 ;General help text routine. Write out the text in the HTEXT array
161 ;----------------------------------------------------------------
162HELP(CALL) ;
163 N HTEXT
164 N DIWF,DIWL,DIWR,IC
165 S DIWF="C70",DIWL=0,DIWR=70
166 ;
167 I CALL=1 D
168 .S HTEXT(1)="Enter 'N' to run the report using the parameters from "
169 .S HTEXT(2)="the existing template. Enter 'Y' to copy/edit the "
170 .S HTEXT(3)="template."
171 ;
172 K ^UTILITY($J,"W")
173 S IC=""
174 F S IC=$O(HTEXT(IC)) Q:IC="" D
175 . S X=HTEXT(IC)
176 . D ^DIWP
177 W !
178 S IC=0
179 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D
180 . W !,^UTILITY($J,"W",0,IC,0)
181 K ^UTILITY($J,"W")
182 W !
183 Q
184 ;
185 ;Reminders Due specific prompts
186 ;------------------------------
187FUT ;For detailed report give option to display future appointments
188 S PXRMFUT="N",PXRMDLOC="N"
189 I PXRMREP="D" D Q:$D(DTOUT)!$D(DUOUT)
190 .D FUTURE^PXRMXSD(.PXRMFUT,"Display All Future Appointments: ",5)
191 .I PXRMFUT="Y" D Q:$D(DTOUT)!$D(DUOUT)
192 ..D FUTURE^PXRMXSD(.PXRMDLOC,"Display Appointment Location: ",15)
193 ;
194SRT ;For detailed report give option to sort by appointment date
195 S PXRMSRT="N"
196 I PXRMREP="D",(PXRMSEL'="I") D G:$D(DUOUT) FUT
197 .;Inpatient report
198 .S PXRMINP=$$INP^PXRMXD
199 .;Option to sort by bed
200 .I PXRMINP D BED^PXRMXSD(.PXRMSRT) Q
201 .;Option to sort by appt date
202 .D SRT^PXRMXSD(.PXRMSRT)
203 ;
204 Q
205 ;
206 ;Input validation for file #810.1
207 ;
208 ;If detail report allow only one reminder
209PXRMREM I $P(^PXRMPT(810.1,DA(1),0),U,6)'="D" Q
210 ;If template has no reminders ignore
211 I +$P($G(^PXRMPT(810.1,DA(1),1,0)),U,4)=0 Q
212 ;If this a new entry
213 I $G(Y)=-1 K X W !,"Only one reminder allowed for detailed report."
214 Q
215 ;
216 ;If changing from Summary to Detail report
217PXRMREP Q:$G(X)'="D"
218 Q:$P($G(^PXRMPT(810.1,DA,0)),U,6)'="S"
219 Q:+$G(NREM)<2
220 W !,"Only the first reminder on this template will be evaluated"
221 Q
Note: See TracBrowser for help on using the repository browser.