source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMGECR.m@ 1458

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

initial load of FOIAVistA 6/30/08 version
File size: 8.7 KB
Line 
1PXRMGECR ;SLC/JVS GEC-Reports ;7/14/05 10:44
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 Q
4LOC ;Referrals by Location
5 N CAT,HF,DATE,DFN,Y,HFN,DFNXX
6 D E^PXRMGECV("LOC",1,BDT,EDT,"F",0)
7 I FORMAT="F" S FOR=1
8 I FORMAT="D" S FOR=0
9 W @IOF
10 W "=============================================================================="
11 W !,"Complete GEC Referrals by Location"
12 W !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
13 I FOR W !,"Location"
14 I FOR W !,?5,"Patient",?50,"Finish Date"
15 I 'FOR W !,"Location^Location Count^Patient^SSN^Finish Date"
16 W !,"=============================================================================="
17 W ! D PB Q:Y=0
18 S LOCN="" F S LOCN=$O(^TMP("PXRMGEC",$J,"TMPLOC",LOCN)) Q:LOCN=""!(Y=0) D
19 .Q:LOCNP'=1&(LOCN'=LOCNP)
20 .I FOR W ! D PB Q:Y=0
21 .I FOR W !,IOUON,LOCN,IOUOFF,?30,"Total # Patients Evaluated= ",$G(^TMP("PXRMGEC",$J,"REFLOCC",LOCN)) D PB Q:Y=0
22 .I FOR W ! D PB Q:Y=0
23 .S DFNXX="" F S DFNXX=$O(^TMP("PXRMGEC",$J,"TMPLOC",LOCN,DFNXX)) Q:DFNXX=""!(Y=0) D
24 ..S VDT=0 F S VDT=$O(^TMP("PXRMGEC",$J,"TMPLOC",LOCN,DFNXX,VDT)) Q:VDT=""!(Y=0) D
25 ...I VDT["0000" I FOR W !,?5,DFNXX,?50,"Incomplete"
26 ...E I FOR W !,?5,$P(DFNXX," ",1,$L(DFNXX," ")-1)," ("_$P(DFNXX," ",$L(DFNXX," "))_")",?50,$P($$FMTE^XLFDT(VDT,"5ZM"),"@",1)
27 ...I FOR D PB Q:Y=0
28 ...I 'FOR W !,LOCN,"^",$G(^TMP("PXRMGEC",$J,"REFLOCC",LOCN)),"^",$P(DFNXX," ",1,$L(DFNXX," ")-1),"^",$P(DFNXX," ",$L(DFNXX," ")),"^",$P($$FMTE^XLFDT(VDT,"5ZM"),"@",1)
29 K ^TMP("PXRMGEC",$J)
30 Q
31 ;_______
32DR ;Referrals by Date Range
33 N CAT,HF,DATE,DFN,Y,HFN,CNTREF,DIF,DIFF
34 D E^PXRMGECV("HS1",INC,BDT,EDT,$S(INC=1:"F",1:"S"),DFNONLY)
35 I FORMAT="D" S FOR=0
36 I FORMAT="F" S FOR=1
37 W @IOF
38 W "=============================================================================="
39 W !,"Complete and/or Incomplete GEC Referrals by Date Range"
40 W !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
41 W !,$S(INC=0:"Incomplete",INC=1:"Complete",INC=2:"Complete and Incomplete",1:"")_" Referrals"
42 I FOR W !,"Patient"
43 I INC=1 I FOR W !,?5,"Start Date",?20,"Finished",?35,"Elapsed Time"
44 E I FOR W !,?5,"Start Date",?20,"Finished",?35,"Elapsed Time",?50,"Incomplete Status"
45 I 'FOR W !,"Patient^SS#^Count^Start Date^Finished Date^Elapsed Time"
46 W !,"=============================================================================="
47 W ! D PB Q:Y=0
48 S DFN="" F S DFN=$O(^TMP("PXRMGEC",$J,"HS1",DFN)) Q:DFN=""!(Y=0) D
49 .I FOR W ! D PB Q:Y=0
50 .I FOR W !,IOUON,$P(DFN," ",1,$L(DFN," ")-1)," ("_$P(DFN," ",$L(DFN," "))_")"," ",IOUOFF
51 .I FOR W ?44,$G(^TMP("PXRMGEC",$J,"REFDFNN",$P(DFN," ",1,($L(DFN," ")-1))))," Referral(s)" D PB Q:Y=0
52 .I FOR W ! D PB Q:Y=0
53 .S CNTREF="" F S CNTREF=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF)) Q:CNTREF=""!(Y=0) D
54 ..S DATE=0 F S DATE=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF,DATE)) Q:DATE=""!(Y=0) D
55 ...S VDT=0 F S VDT=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF,DATE,VDT)) Q:VDT=""!(Y=0) D
56 ....S DIFF="" I VDT>0 S DIFF=$$FMDIFF^XLFDT(VDT,DATE,1)+1
57 ....S DIF="" S DIF=$$FMDIFF^XLFDT(DT,DATE,1)+1
58 ....I VDT["0000" I FOR W !,?5,$P($$FMTE^XLFDT(DATE,"5ZM"),"@",1),?20,"",?35,$S(DIFF="":DIF_" Days",DIFF>0:DIFF_" Days",1:""),?50,$S(DIFF="":"Incomplete",1:"")
59 ....E I FOR W !,?5,$P($$FMTE^XLFDT(DATE,"5ZM"),"@",1),?20,$P($$FMTE^XLFDT(VDT,"5ZM"),"@",1),?35,$S(DIFF="":DIF_" Days",DIFF>0:DIFF_" Days",1:""),?50,$S(DIFF="":"Incomplete",1:"")
60 ....I FOR D PB Q:Y=0
61 ....I 'FOR W !,$P(DFN," ",1,$L(DFN," ")-1),"^",$P(DFN," ",$L(DFN," ")),"^"
62 ....I 'FOR W $G(^TMP("PXRMGEC",$J,"REFDFNN",$P(DFN," ",1,$L(DFN," ")-1))),"^",$P($$FMTE^XLFDT(DATE,"5ZM"),"@",1),"^",$P($$FMTE^XLFDT(VDT,"5ZM"),"@",1),"^",$S(DIFF="":DIF,DIFF>0:DIFF,1:"")
63 K ^TMP("PXRMGEC",$J)
64 Q
65 ;_____
66HS1 ;By Patient
67 N CAT,HF,DATE,DFN,Y,HFN,CNTREF,X,REFNUM,CNT,STATUS,NAME,DIV
68 D E^PXRMGECV("HS1",1,BDT,EDT,"F",DFNONLY)
69 I FORMAT="D" S FOR=0
70 I FORMAT="F" S FOR=1
71 W @IOF
72 W "=============================================================================="
73 W !,"GEC Patient"
74 W !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
75 I FOR W !,"Patient"
76 I FOR W !," Category"
77 I FOR W !," Health Factor",?44,"Value",?55,"Date of Evaluation"
78 I 'FOR W !,"Patient^Category^Health Factor^Value^Date of Evaluation"
79 W !,"=============================================================================="
80 S CNT=0
81 S Y=1
82 S DFN="" F S DFN=$O(^TMP("PXRMGEC",$J,"HS1",DFN)) Q:DFN=""!(Y=0) D
83 .N NAME,DFNN,STATUS,DIV
84 .I FOR W ! D PB Q:Y=0
85 .S NAME=$P(DFN," ",1,$L(DFN," ")-1)
86 .S DFNN=$O(^DPT("B",NAME,0)) D
87 ..Q:DFNN=""
88 ..S STATUS=$S($D(^DPT(DFNN,.1)):"INPATIENT",1:"OUTPATIENT")
89 ..S DIV=$$GET1^DIQ(2,DFNN,.19) I DIV="" S DIV="Unknown"
90 .S CNT=CNT+1
91 .I STATUS["IN" I FOR W !,CNT,") ",STATUS,", DIVISION:",DIV D PB Q:Y=0
92 .I STATUS["OU" I FOR W !,CNT,") ",STATUS D PB Q:Y=0
93 .I FOR W !,CNT,") ",IOUON,$P(DFN," ",1,$L(DFN," ")-1)," (",$P(DFN," ",$L(DFN," "))_")",IOUOFF,?48,"Total # Complete referrals: ",$G(^TMP("PXRMGEC",$J,"REFDFNN",$P(DFN," ",1,$L(DFN," ")-1))) D PB Q:Y=0
94 .S CNTREF="",REFNUM=0 F S CNTREF=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF)) Q:CNTREF=""!(Y=0) D
95 ..I FOR W ! D PB Q:Y=0
96 ..S REFNUM=REFNUM+1
97 ..I FOR W !,IOUON,"Referral #"_REFNUM,IOUOFF D PB Q:Y=0
98 ..S DATE=0 F S DATE=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF,DATE)) Q:DATE=""!(Y=0) D
99 ...S VDT=0 F S VDT=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF,DATE,VDT)) Q:VDT=""!(Y=0) D
100 ....S CAT=0 F S CAT=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF,DATE,VDT,CAT)) Q:CAT=""!(Y=0) D
101 .....I FOR W !,?1,$P(CAT," ",3,6) D PB Q:Y=0
102 .....S DATEV=0 F S DATEV=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF,DATE,VDT,CAT,DATEV)) Q:DATEV=""!(Y=0) D
103 ......S DA=0 F S DA=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF,DATE,VDT,CAT,DATEV,DA)) Q:DA=""!(Y=0) D
104 .......S HFN=$$HFNAME(DA)
105 .......I FOR W !,?4,$P(HFN,"^",1),?44,$P(HFN,"^",2),?55,$P($$FMTE^XLFDT(DATEV,"5ZM"),"@",1)
106 .......I FOR D PB Q:Y=0
107 .......S COMMENT=$G(^AUPNVHF(DA,811))
108 .......I FOR I COMMENT'="" D COM^PXRMGECZ
109 .......I 'FOR W !,$P(DFN," ",1,$L(DFN," ")-1)_"^"_$P(DFN," ",$L(DFN," ")),"^",$P(CAT," ",3,6),"^",$P(HFN,"^",1),"^",$P(HFN,"^",2),"^",$P($$FMTE^XLFDT(DATEV,"5ZM"),"@",1),"^",REFNUM
110 K ^TMP("PXRMGEC",$J)
111 Q
112 ;______
113HFCD ;Health Factor Category Detailed
114 N CAT,HF,DATE,DFN,DFN1,FOR,HFDA,COMMENT
115 I FORMAT="D" S FOR=0
116 I FORMAT="F" S FOR=1
117 K ^TMP("PXRMGEC",$J,"HFCD")
118 D E^PXRMGECV("HFCD",1,BDT,EDT,"F",DFNONLY)
119 W @IOF
120 W "=============================================================================="
121 W !,"GEC Health Factor Category Detailed Report"
122 W !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
123 W !,"Complete and Incomplete Referrals"
124 I FOR W !,"Category"
125 I FOR W !,?2,"Patient Name"
126 I FOR W !,?4,"Health Factors",?45,$S($D(RPT7):"",1:"Value"),?52,"Date"
127 I 'FOR W !,"Category^Patient^SSN^Health Factor^"_$S($D(RPT7):"Date",1:"Value^Date")
128 W !,"=============================================================================="
129 D PB Q:Y=0
130 S CAT="" F S CAT=$O(^TMP("PXRMGEC",$J,"HFCD",CAT)) Q:CAT=""!(Y=0) D
131 .S DFN1=0
132 .I FOR W ! D PB Q:Y=0
133 .I FOR W !,IOUON,$P(CAT," ",3,6),IOUOFF D PB Q:Y=0
134 .S DFN=0 F S DFN=$O(^TMP("PXRMGEC",$J,"HFCD",CAT,DFN)) Q:DFN=""!(Y=0) D
135 ..S HF="" F S HF=$O(^TMP("PXRMGEC",$J,"HFCD",CAT,DFN,HF)) Q:HF=""!(Y=0) D
136 ...S DATE=0 F S DATE=$O(^TMP("PXRMGEC",$J,"HFCD",CAT,DFN,HF,DATE)) Q:DATE=""!(Y=0) D
137 ....I FOR I DFN'=DFN1 W ! D PB Q:Y=0
138 ....I FOR I DFN'=DFN1 W !,?2,$P($G(^DPT(DFN,0)),"^",1)_" ("_$P($G(^DPT(DFN,0)),"^",9)_")" D PB Q:Y=0 W ! D PB Q:Y=0 S DFN1=DFN
139 ....S HFN=$$HFNAME(0,HF)
140 ....S HFDA=$O(^TMP("PXRMGEC",$J,"HFCD",CAT,DFN,HF,DATE,0))
141 ....I FOR W !,?4,$P(HFN,"^",1),?45,$S($D(RPT7):"",1:$P(HFN,"^",2)),?52,$P($$FMTE^XLFDT(DATE,"5ZM"),"@",1)
142 ....I FOR D PB Q:Y=0
143 ....S COMMENT=$G(^AUPNVHF(HFDA,811))
144 ....I FOR I COMMENT'="" D COM^PXRMGECZ
145 ....I 'FOR W !,$P(CAT," ",3,5),"^",$P($G(^DPT(DFN,0)),"^",1)_"^"_$P($G(^DPT(DFN,0)),"^",9),"^",$P(HFN,"^",1),$S($D(RPT7):"",1:"^"_$P(HFN,"^",2)),"^",$P($$FMTE^XLFDT(DATE,"5ZM"),"@",1)
146 K ^TMP("PXRMGEC",$J)
147 D ^%ZISC
148 Q
149 ;____
150LOCCNT ;Count Locations of Referrals
151 N LOC,VDT
152 S LOC="" F S LOC=$O(^TMP("PXRMGEC",$J,"LOCB",LOC)) Q:LOC="" D
153 .S VDT="" F S VDT=$O(^TMP("PXRMGEC",$J,"LOCB",LOC,VDT)) Q:VDT="" D
154 ..I $D(^TMP("PXRMGEC",$J,"LOCBB",LOC)) S ^TMP("PXRMGEC",$J,"LOCBB",LOC)=$G(^TMP("PXRMGEC",$J,"LOCBB",LOC))+1
155 ..E S ^TMP("PXRMGEC",$J,"LOCBB",LOC)=1
156 Q
157 ;
158HFNAME(DA,NAME) ;Decide to split name into columns
159 N WHOLE,FIRST,SECOND,REF,REF2,RESULT
160 I DA>0 D
161 .S WHOLE=$P($G(^AUTTHF($P($G(^AUPNVHF(DA,0)),"^",1),0)),"^",1)
162 E S WHOLE=NAME
163 I $D(RPT7) D
164 .I WHOLE["(REFERRED TO)" D
165 ..S WHOLE=$P(WHOLE," (",1)
166 S RESULT="^"
167 S REF="YESNOSTAGE 1STAGE 2STAGE 3STAGE 4"
168 S REF2="12"
169 S FIRST=$P(WHOLE,"-",1,$L(WHOLE,"-")-1)
170 S SECOND=$P(WHOLE,"-",$L(WHOLE,"-"))
171 I REF[SECOND S RESULT=FIRST_"^"_SECOND
172 E S RESULT=WHOLE_"^"
173 I REF2[SECOND S RESULT=WHOLE_"^"
174 Q RESULT
175 ;=====
176PB ;PAGE BREAK
177 S Y=""
178 I $Y=(IOSL-2)!($Y=(IOSL-3)) D
179 .K DIR
180 .S DIR(0)="E"
181 .D ^DIR
182 .I Y=1 W @IOF S $Y=0
183 K DIR
184 Q
185 ;
Note: See TracBrowser for help on using the repository browser.