1 | PXRMXDT1 ; SLC/PJH - Build Patient list SUBROUTINES;07/10/2006
|
---|
2 | ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
|
---|
3 | ;
|
---|
4 | ; Called by label from PXRMXSEO,PXRMXSE
|
---|
5 | ;
|
---|
6 | ;Combined report duplicate check (Summary report)
|
---|
7 | NEW(SUB,SUB1,SUB2) ;
|
---|
8 | ;Existing entry
|
---|
9 | I $D(^TMP("PXRMCMB",$J,SUB,SUB1,SUB2)) Q 0
|
---|
10 | ;New entry
|
---|
11 | S ^TMP("PXRMCMB",$J,SUB,SUB1,SUB2)=""
|
---|
12 | Q 1
|
---|
13 | ;
|
---|
14 | ;Individual patient report duplicate patient check
|
---|
15 | NEWIP(DFN) ;
|
---|
16 | ;Existing entry
|
---|
17 | I $D(^TMP("PXRMCMB3",$J,DFN)) Q 0
|
---|
18 | ;New entry
|
---|
19 | S ^TMP("PXRMCMB3",$J,DFN)=""
|
---|
20 | Q 1
|
---|
21 | ;Combined report duplicate check (Detail report)
|
---|
22 | NEWP(SUB,DFN) ;
|
---|
23 | ;Existing entry
|
---|
24 | I $D(^TMP("PXRMCMB1",$J,SUB,DFN)) Q 0
|
---|
25 | ;New entry
|
---|
26 | S ^TMP("PXRMCMB1",$J,SUB,DFN)=""
|
---|
27 | Q 1
|
---|
28 | ;
|
---|
29 | ;Combined report duplicate check (Patient totals)
|
---|
30 | NEWT(FACILITY,DFN) ;
|
---|
31 | ;Existing entry
|
---|
32 | I $D(^TMP("PXRMCMB2",$J,FACILITY,DFN)) Q 0
|
---|
33 | ;New entry
|
---|
34 | S ^TMP("PXRMCMB2",$J,FACILITY,DFN)=""
|
---|
35 | Q 1
|
---|
36 | ;
|
---|
37 | ;Detailed report
|
---|
38 | SDET(DFN,STATUS,NAM,FACILITY,INP) ;
|
---|
39 | I $G(^XTMP(PXRMXTMP,PX,FACILITY,NAM))="" D
|
---|
40 | .S ^XTMP(PXRMXTMP,PX,FACILITY,NAM)=NAM
|
---|
41 | ;Applicable
|
---|
42 | S DDAT="N/A"
|
---|
43 | N APPL,FAPPTDT,DEFARR,DNEXT,DNEXT1,FIEV,PXRMDATE,BID,TMPSUB
|
---|
44 | S APPL=0,FAPPTDT=0
|
---|
45 | ;Add any that aren't N/A, Ignore on N/A or NEVER to applicable total
|
---|
46 | I ($P(STATUS,U)'="")&(STATUS'["NEVER")&(STATUS'["N/A")&(STATUS'["ERROR")&(STATUS'["CNBD") S APPL=1
|
---|
47 | ;If DUE NOW save details
|
---|
48 | I $G(STATUS)'["DUE NOW" S PNAM=" "
|
---|
49 | I $G(STATUS)["DUE NOW" D
|
---|
50 | .N BED
|
---|
51 | .S DDUE=$P($G(STATUS),U,2)
|
---|
52 | .S DLAST=$P($G(STATUS),U,3)
|
---|
53 | .;Demographics
|
---|
54 | .S PNAM=$P($G(^DPT(DFN,0)),U),BID=$P($G(^DPT(DFN,0)),U,9)
|
---|
55 | .I PNAM="" S PNAM=" "
|
---|
56 | .E S PNAM=PNAM_U_BID
|
---|
57 | .;Next appointment for location or clinic
|
---|
58 | .;For detailed provider report get next appoint. for assoc. clinic
|
---|
59 | .S DNEXT=""
|
---|
60 | .I PXRMSEL="L"!(PXRMSEL="P") S TMPSUB="PXRM FUTURE APPT"
|
---|
61 | .E S TMPSUB="SDAMA301"
|
---|
62 | .I PXRMFCMB="Y",PXRMLCMB="Y",$D(^TMP($J,TMPSUB,DFN))>0 D
|
---|
63 | ..N APPTCNT,LOC
|
---|
64 | ..S LOC=0,APPTCNT=0
|
---|
65 | ..F S LOC=$O(^TMP($J,TMPSUB,DFN,LOC)) Q:(LOC'>0)!(APPTCNT=1) D
|
---|
66 | ...S DNEXT=$O(^TMP($J,TMPSUB,DFN,LOC,"")) I +DNEXT>0 S APPTCNT=1 Q
|
---|
67 | .S DNEXT=$O(^TMP($J,TMPSUB,DFN,$G(INP),""))
|
---|
68 | .I PXRMFCMB="N",PXRMLCMB="Y" D
|
---|
69 | ..S DNEXT1=$O(^TMP($J,"PXRM FACILITY FUTURE APPT",DFN,FACILITY,"")) Q:DNEXT1'>0
|
---|
70 | ..I +DNEXT=0!(DNEXT>DNEXT1) S DNEXT=DNEXT1
|
---|
71 | .S BED=$G(^DPT(DFN,.101)) S:BED="" BED="NONE"
|
---|
72 | .;Sort by next appointment date
|
---|
73 | .I PXRMSRT="Y" S DDAT=$P(DNEXT,".") S:DDAT="" DDAT="NONE"
|
---|
74 | .;Patient ward/bed used only for inpatient reports
|
---|
75 | .I PXRMFUT="Y" S DNEXT=""
|
---|
76 | .N TXT
|
---|
77 | .S TXT=DFN_U_DDUE_U_DLAST_U_$G(DNEXT)_$S($G(BED)'="":U_BED,1:"")
|
---|
78 | .I $G(BED)'="",BED'="NONE" S DDAT=BED
|
---|
79 | .N BED
|
---|
80 | .S BED=""
|
---|
81 | .I $G(PXRMINP) D
|
---|
82 | ..S BED=$G(^DPT(DFN,.101)) S:BED="" BED="NONE"
|
---|
83 | ..S TXT=TXT_U_BED
|
---|
84 | ..;Sort by bed
|
---|
85 | ..I PXRMSRT="B" S DDAT=BED
|
---|
86 | .;Duplicate check for combined report
|
---|
87 | .I PXRMFCMB="Y",'$$NEW(NAM,DDAT,PNAM) Q
|
---|
88 | .;I PXRMFCMB'="Y",PXRMLCMB="Y",'$$NEW^PXRMXSEO(NAM,DDAT,PNAM) Q
|
---|
89 | .;Save entry in ^XTMP
|
---|
90 | .S ^XTMP(PXRMXTMP,PX,FACILITY,NAM,DDAT,PNAM)=TXT
|
---|
91 | .;Total of reminders overdue
|
---|
92 | .N CNT
|
---|
93 | .S CNT=$P(^XTMP(PXRMXTMP,PX,FACILITY,NAM),U,2)
|
---|
94 | .S $P(^XTMP(PXRMXTMP,PX,FACILITY,NAM),U,2)=CNT+1
|
---|
95 | ;Total of patients checked/applicable
|
---|
96 | N CNT,NEW
|
---|
97 | S NEW=1 I PXRMFCMB="Y" S NEW=$$NEWP(NAM,DFN)
|
---|
98 | I NEW=1 D
|
---|
99 | .S CNT=$P(^XTMP(PXRMXTMP,PX,FACILITY,NAM),U,3)
|
---|
100 | .S $P(^XTMP(PXRMXTMP,PX,FACILITY,NAM),U,3)=CNT+1
|
---|
101 | .S CNT=$P(^XTMP(PXRMXTMP,PX,FACILITY,NAM),U,4)
|
---|
102 | .S $P(^XTMP(PXRMXTMP,PX,FACILITY,NAM),U,4)=CNT+APPL
|
---|
103 | I PXRMFUT="Y"&($G(STATUS)["DUE NOW") D
|
---|
104 | .N APPTARY,APPTDT,CIEN,CNT,NODE,SUB
|
---|
105 | .S SUB="" I $D(^TMP($J,"PXRM FUTURE APPT",DFN))>0 S SUB="PXRM FUTURE APPT"
|
---|
106 | .I SUB="",$D(^TMP($J,"SDAMA301",DFN))>0 S SUB="SDAMA301"
|
---|
107 | .I SUB="" Q
|
---|
108 | .S CNT=0
|
---|
109 | .S CIEN=0 F S CIEN=$O(^TMP($J,SUB,DFN,CIEN)) Q:CIEN'>0 D
|
---|
110 | ..S APPTDT=0
|
---|
111 | ..F S APPTDT=$O(^TMP($J,SUB,DFN,CIEN,APPTDT)) Q:APPTDT'>0 D
|
---|
112 | ...S NODE=$G(^TMP($J,SUB,DFN,CIEN,APPTDT))
|
---|
113 | ...S APPTARY(APPTDT)=APPTDT_U_$P($P(NODE,U,2),";",2)_U_$P($P(NODE,U,22),";",2)
|
---|
114 | .S APPTDT=0 F S APPTDT=$O(APPTARY(APPTDT)) Q:APPTDT'>0 S CNT=CNT+1,^XTMP(PXRMXTMP,PX,FACILITY,NAM,DDAT,PNAM,CNT,0)=APPTARY(APPTDT)
|
---|
115 | Q
|
---|
116 | ;
|
---|
117 | SUM(DFN,STATUS,FACILITY,NAM) ;
|
---|
118 | N DUE,EVAL
|
---|
119 | S (DUE,EVAL)=0
|
---|
120 | ;Add dues to totals of reminders due and reminders applicable
|
---|
121 | I STATUS["DUE NOW" D
|
---|
122 | .S DUE=1,EVAL=1
|
---|
123 | ;Add any that aren't N/A, Ignore on N/A,ERROR or NEVER to applicable total
|
---|
124 | S STATUS=$P(STATUS,U)
|
---|
125 | I (STATUS'=" ")&(STATUS'["NEVER")&(STATUS'="N/A")&(STATUS'["ERROR")&(STATUS'["CNBD") S EVAL=1
|
---|
126 | ;Update XTMP - Total of reminders due
|
---|
127 | I "IR"[PXRMTOT D
|
---|
128 | .;Combined facility duplicate check
|
---|
129 | .I PXRMFCMB="Y",'$$NEW(NAM,DFN,ITEM) Q
|
---|
130 | .N CNT
|
---|
131 | .S CNT=$P($G(^XTMP(PXRMXTMP,PX,FACILITY,NAM,ITEM)),U,1)
|
---|
132 | .S $P(^XTMP(PXRMXTMP,PX,FACILITY,NAM,ITEM),U,1)=CNT+EVAL
|
---|
133 | .;Total of reminders evaluated
|
---|
134 | .S CNT=$P($G(^XTMP(PXRMXTMP,PX,FACILITY,NAM,ITEM)),U,2)
|
---|
135 | .S $P(^XTMP(PXRMXTMP,PX,FACILITY,NAM,ITEM),U,2)=CNT+DUE
|
---|
136 | ;
|
---|
137 | ;Totals
|
---|
138 | I "RT"[PXRMTOT D
|
---|
139 | .;Check for duplicate patient at FACILITY level
|
---|
140 | .I $D(^TMP("PXRMDUP",$J,FACILITY,DFN,ITEM)) Q
|
---|
141 | .;Set duplicate check
|
---|
142 | .S ^TMP("PXRMDUP",$J,FACILITY,DFN,ITEM)=""
|
---|
143 | .I $G(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL"))="" D
|
---|
144 | ..S ^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL")="TOTAL"
|
---|
145 | .N CNT
|
---|
146 | .S CNT=$P($G(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL",ITEM)),U,1)
|
---|
147 | .S $P(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL",ITEM),U,1)=CNT+EVAL
|
---|
148 | .S CNT=$P($G(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL",ITEM)),U,2)
|
---|
149 | .S $P(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL",ITEM),U,2)=CNT+DUE
|
---|
150 | ;
|
---|
151 | ;Total of patients
|
---|
152 | I "IR"[PXRMTOT D
|
---|
153 | .I PXRMSEL="I",$$NEWIP(DFN)<1 Q
|
---|
154 | .I $$NEWP(@SUB,DFN)=0 Q
|
---|
155 | .I $G(^XTMP(PXRMXTMP,PX,FACILITY,@SUB))="" S ^XTMP(PXRMXTMP,PX,FACILITY,@SUB)=NAM
|
---|
156 | .N CNT S CNT=$P($G(^XTMP(PXRMXTMP,PX,FACILITY,@SUB)),U,3)
|
---|
157 | .S $P(^XTMP(PXRMXTMP,PX,FACILITY,@SUB),U,3)=CNT+1
|
---|
158 | ;
|
---|
159 | ;Total reports
|
---|
160 | I "TR"[PXRMTOT D
|
---|
161 | .I '$$NEWT(FACILITY,DFN) Q
|
---|
162 | .I $G(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL"))="" D
|
---|
163 | ..S ^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL")=NAM
|
---|
164 | .N CNT
|
---|
165 | .S CNT=$P($G(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL")),U,3)
|
---|
166 | .S $P(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL"),U,3)=CNT+1
|
---|
167 | Q
|
---|
168 | ;
|
---|
169 | DBDOWN(TYPE) ;
|
---|
170 | N CNT,CNT1,CNT2,STR,NLINES,OUTPUT,TIME
|
---|
171 | K ^TMP("PXRMXMZ",$J)
|
---|
172 | S NLINES=0,CNT=0,CNT1=2
|
---|
173 | I TYPE="C" D Q
|
---|
174 | .M ^TMP("PXRMXMZ",$J)=^TMP($J,"PXRM CNBD")
|
---|
175 | .D SEND^PXRMMSG("COULD NOT BE DETERMINED PATIENTS("_$$FMTE^XLFDT($$NOW^XLFDT)_")",1)
|
---|
176 | I 'PXRMQUE D
|
---|
177 | .S STR(1)="The Reminders Due Report "_$G(TITLE)_" requested by "_$$GET1^DIQ(200,DUZ,.01)_" on "_$$FMTE^XLFDT($G(PXRMXST))_" for the following reason(s):"
|
---|
178 | .F S CNT=$O(DBERR(CNT)) Q:CNT'>0 S STR(CNT1)="\\"_DBERR(CNT),CNT1=CNT1+1
|
---|
179 | .D FORMAT^PXRMTEXT(1,80,2,.STR,.NLINES,.OUTPUT)
|
---|
180 | .F CNT=1:1:NLINES W !,OUTPUT(CNT)
|
---|
181 | I PXRMQUE D
|
---|
182 | .S ^TMP("PXRMXMZ",$J,1,0)="The Reminders Due Report "_$G(TITLE)_" requested by "_$$GET1^DIQ(200,DUZ,.01)_" on "_$$FMTE^XLFDT($G(PXRMXST))_" for the following reason(s):"
|
---|
183 | .F S CNT=$O(DBERR(CNT)) Q:CNT'>0 S ^TMP("PXRMXMZ",$J,CNT1,0)=DBERR(CNT),CNT1=CNT1+1
|
---|
184 | .D SEND^PXRMMSG("Cancelled Reminders Due Report("_$$FMTE^XLFDT($$NOW^XLFDT)_")",1)
|
---|
185 | .S ZTSTOP=1
|
---|
186 | Q
|
---|