source: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECRPCLS.m@ 1141

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

initial load of WorldVistAEHR

File size: 6.6 KB
RevLine 
[613]1ECRPCLS ;ALB/JAP - Event Capture Invalid Provider Report ; 13 Aug 97
2 ;;2.0; EVENT CAPTURE ;**5,47**;8 May 96
3 ;
4EN ;entry point from menu option
5 W !
6 D RANGE
7 I '$G(ECLOOP)!'$G(ECBEGIN)!'$G(ECEND) G EXIT
8 W !
9 D SORT
10 I $G(DIRUT) G EXIT
11 I "PR"'[$G(ECSORT) G EXIT
12 K DIR,DIRUT,DUOUT
13 W !
14 D DEVICE
15 I POP G EXIT
16 I $G(ZTSK) G EXIT
17 I $G(IO("Q")),'$G(ZTSK) G EXIT
18 D START
19 D HOME^%ZIS
20 G EXIT
21 ;
22START ;queued entry point or continuation
23 D PROCESS
24 U IO D PRINT
25 I $D(ECGUI) D EXIT Q
26 I IO'=IO(0) D ^%ZISC
27 I $D(ZTQUEUED) S ZTREQ="@" D EXIT
28 Q
29 ;
30RANGE ;get any date range between T and T-365
31 N X1,X2,ECSTDT,ECENDDT
32 W !,?5,"Enter a Begin Date and End Date for this Event Capture "
33 W !,?5,"provider report -- both dates must be within the past "
34 W !,?5,"365 days.",!
35 S (ECBEGIN,ECEND)=0
36 F D Q:ECBEGIN>0 Q:'$G(ECLOOP)
37 .S ECLOOP=$$STDT^ECRUTL() I 'ECLOOP Q
38 .S ECBEGIN=ECSTDT
39 .S X1=DT,X2=ECBEGIN D ^%DTC I X>365 D
40 ..W !!,?15,"The Begin Date for this report may not be"
41 ..W !,?15,"more than 365 days ago. Try again...",!
42 ..S ECBEGIN=0
43 Q:'$G(ECLOOP)!'$G(ECBEGIN)
44 F D Q:ECEND>0 Q:'$G(ECLOOP)
45 .S ECLOOP=$$ENDDT^ECRUTL(ECSTDT) I 'ECLOOP Q
46 .S ECEND=ECENDDT
47 .I ECEND>(DT+1) D
48 ..W !!,?15,"The End Date for this report may not be"
49 ..W !,?15,"a future date. Try again...",!
50 ..S ECEND=0
51 Q
52 ;
53SORT ;ask user if report should be alpha by patient (P) or
54 ; alpha by provider (R)
55 K DIR
56 S DIR(0)="SAXB^P:PATIENT;R:PROVIDER"
57 S DIR("?")="Enter an uppercase 'P' or 'R'."
58 S DIR("A")="Select sorting by Patient or pRovider (P/R): "
59 S DIR("A",1)=" "
60 S DIR("A",2)="If you want the report to show Patient name in the 1st column,"
61 S DIR("A",3)="enter a 'P'. The listing will be alphabetical by Patient name."
62 S DIR("A",4)=" "
63 S DIR("A",5)="If you want the report to show Provider name in the 1st column,"
64 S DIR("A",6)="enter an 'R'. The listing will be alphabetical by Provider name."
65 S DIR("A",7)=" "
66 D ^DIR
67 Q:$G(DIRUT)
68 S ECSORT=Y
69 Q
70 ;
71DEVICE ;get device and queue
72 K IOP S %ZIS="QM" D ^%ZIS
73 I POP W !!,"No device selected. Exiting...",!! S DIR(0)="E" W ! D ^DIR K DIR Q
74 I $D(IO("Q")) D
75 .S ZTRTN="START^ECRPCLS",ZTDESC="EC Invalid Provider Report"
76 .S ZTSAVE("ECBEGIN")="",ZTSAVE("ECEND")="",ZTSAVE("ECSORT")=""
77 .D ^%ZTLOAD
78 .I '$G(ZTSK) W !,"Report canceled..." S DIR(0)="E" W ! D ^DIR K DIR Q
79 .W !,"Report queued as Task #: ",ZTSK S DIR(0)="E" W ! D ^DIR K DIR
80 Q
81 ;
82PROCESS ;process the "AC" x-ref in file #721
83 ;^ECH("AC",date,file#721 ien)=""
84 ;$ORDER from begindate to enddate
85 ;use $$GET^XUA4A72(provider ien,date)
86 ;if return is >0 then get next x-ref entry
87 ;
88 N ECD,ECDATA,ECDATE,ECDDT,ECDT,ECERR,ECIEN,ECPIEN,ECPRDT,ECPRIEN,ECPRVN,ECPT,ECPTN,ECS,ECSSN,ECT,ECU,ECU2,ECU3
89 K ^TMP("ECRPCLS",$J) S ECDT=ECBEGIN
90 F S ECDT=$O(^ECH("AC",ECDT)) Q:ECDT>ECEND Q:ECDT="" D
91 .S ECIEN=""
92 .F S ECIEN=$O(^ECH("AC",ECDT,ECIEN)) Q:ECIEN="" D
93 ..S ECDATA=$G(^ECH(ECIEN,0)) I '+ECDATA Q ;file problem
94 ..S ECPRDT=$P(ECDT,".",1),ECDDT=$P(ECDATA,"^",3) I ECDDT'=ECDT S ECPRDT=$P(ECDDT,".",1) ;there's a problem in the x-ref
95 ..I ECPRDT<ECBEGIN!(ECPRDT>ECEND) Q
96 ..S ECU=$P(ECDATA,"^",11),ECU2=$P(ECDATA,"^",15),ECU3=$P(ECDATA,"^",17)
97 ..F ECPIEN=ECU,ECU2,ECU3 D
98 ...Q:'+ECPIEN
99 ...S ECERR=$$GET^XUA4A72(ECPIEN,ECPRDT) Q:+ECERR>0
100 ...S ECD=$P(ECDDT,".",1),ECT=$P(ECDDT,".",2)
101 ...S ECDATE=$E(ECD,4,5)_"/"_$E(ECD,6,7)_"/"_$E(ECD,2,3) I +ECT S ECT=$$LJ^XLFSTR(ECT,4,0),ECDATE=ECDATE_" "_$E(ECT,1,2)_":"_$E(ECT,3,4)
102 ...S ECPT=$P(ECDATA,"^",2),ECPTN=$P($G(^DPT(ECPT,0)),"^",1) Q:ECPTN=""
103 ...S ECS=$P(^(0),"^",9),ECS=$E(ECS,1,9),ECSSN=$E(ECS,6,9)
104 ...S ECPRVN=$P($G(^VA(200,ECPIEN,0)),"^",1) Q:ECPRVN=""
105 ...S ECPRIEN="("_ECPIEN_")",ECPRIEN=$$RJ^XLFSTR(ECPRIEN,10," ")
106 ...;if sort by patient then patient name is 3rd subscript
107 ...I ECSORT="P" S ^TMP("ECRPCLS",$J,ECPTN,ECPRVN,ECIEN)=ECERR_"^"_ECPRIEN_"^"_ECSSN_"^"_ECDATE
108 ...;if sort by provider then provider name is 3rd subscript
109 ...I ECSORT="R" S ^TMP("ECRPCLS",$J,ECPRVN,ECPTN,ECIEN)=ECERR_"^"_ECPRIEN_"^"_ECSSN_"^"_ECDATE
110 Q
111 ;
112PRINT ;output report
113 ;
114 N X1,X2,PROVIDER,PATIENT,PAGE,PRNTDT,QFLAG,DASH,JJ,SS
115 N ECDATA,ECDATE,ECERR,ECIEN,ECPRIEN,ECPRVN,ECPTN,ECSSN
116 S (PAGE,QFLAG)=0 S $P(DASH,"-",80)=""
117 S Y=$P(ECBEGIN,".",1)+1 D DD^%DT S ECBEGIN=Y S Y=$P(ECEND,".",1) D DD^%DT S ECEND=Y
118 D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S PRNTDT=Y
119 D HEAD
120 I '$D(^TMP("ECRPCLS",$J)) D Q
121 .W !!,?12,"No invalid providers found for date range specified."
122 .I $E(IOST)="C"&('QFLAG) S DIR(0)="E" D D ^DIR K DIR
123 ..S SS=22-$Y F JJ=1:1:SS W !
124 .W:$E(IOST)'="C" @IOF
125 S X1="" F S X1=$O(^TMP("ECRPCLS",$J,X1)) Q:X1="" D
126 .S:ECSORT="P" ECPTN=X1 S:ECSORT="R" ECPRVN=X1
127 .S X2="" F S X2=$O(^TMP("ECRPCLS",$J,X1,X2)) Q:X2="" D
128 ..S:ECSORT="P" ECPRVN=X2 S:ECSORT="R" ECPTN=X2
129 ..S ECIEN="",ECIEN=$O(^TMP("ECRPCLS",$J,X1,X2,ECIEN)),ECDATA=^(ECIEN)
130 ..S ECERR=$P(ECDATA,"^",1),ECPRIEN=$P(ECDATA,"^",2),ECSSN=$P(ECDATA,"^",3),ECDATE=$P(ECDATA,"^",4)
131 ..S PROVIDER=$$LJ^XLFSTR($E(ECPRVN,1,20),20," ")_" "_ECPRIEN_" "_ECERR
132 ..S PATIENT=$$LJ^XLFSTR($E(ECPTN,1,20),20," ")_" "_ECSSN_" "_ECDATE
133 ..D:($Y+3>IOSL) HEAD
134 ..I ECSORT="P" W !,PATIENT_" "_PROVIDER
135 ..I ECSORT="R" W !,PROVIDER_" "_PATIENT
136 I $E(IOST)="C"&('QFLAG) S DIR(0)="E" D D ^DIR W @IOF
137 .S SS=22-$Y F JJ=1:1:SS W !
138 W:$E(IOST)'="C" @IOF
139 Q
140 ;
141HEAD ;report header
142 ;write the header line with page # and print date and explanation
143 I $E(IOST)="C" S SS=22-$Y F JJ=1:1:SS W !
144 I $E(IOST)="C",PAGE>0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLAG=1 Q
145 W:$Y!($E(IOST)="C") @IOF
146 S PAGE=PAGE+1
147 W !,?12,"Event Capture Providers with Inactive/Missing Person Class"
148 W !,?12,"for the Date Range "_ECBEGIN_" through "_ECEND
149 W !!,"Printed: "_PRNTDT,?65,"Page: "_PAGE,!
150 I PAGE=1 D
151 .W !,?12,"The following entries in the Event Capture Patient file (#721)"
152 .W !,?12,"are associated with a provider who meets one of the following"
153 .W !,?12,"criteria:",!
154 .W !,?22,"(a) The provider has no Person Class"
155 .W !,?22," specified in file #200. (Error=-1)"
156 .W !,?22,"(b) The provider does not have an active"
157 .W !,?22," Person Class in file #200 for the"
158 .W !,?22," date of procedure. (Error=-2)",!
159 .W !,?12,"The provider's record number in file #200 is shown in parentheses"
160 .W !,?12,"after the provider name.",!
161 I ECSORT="P" D SUBHDA
162 I ECSORT="R" D SUBHDB
163 Q
164 ;
165SUBHDA ;subheader for sort by patient
166 W !,?27,"Date of"
167 W !,"Patient",?21,"SSN",?27,"Procedure",?43,"Provider",?75,"Err."
168 W !,DASH,!
169 Q
170 ;
171SUBHDB ;subheader for sort by provider
172 W !,?65,"Date of"
173 W !,"Provider",?32,"Err.",?38,"Patient",?59,"SSN",?65,"Procedure"
174 W !,DASH,!
175 Q
176 ;
177EXIT ;common exit point & clean-up
178 D ^ECKILL
179 D:'$D(ECGUI) ^%ZISC
180 K ^TMP("ECRPCLS",$J)
181 K DIR,DIRUT,DTOUT,DUOUT,ECBEGIN,ECEND,ECSORT,ECLOOP
182 K IO("Q"),POP,X,Y,ZTSK,ZTRTN,ZTDESC,ZTSAVE
183 Q
Note: See TracBrowser for help on using the repository browser.