source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORLPSR.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: 8.2 KB
Line 
1ORLPSR ; SLC/RAF-unsigned orders search ;10/19/00 14:02
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
3 ;
4 ;This routine will loop thru the "AS" xref in file 100 and
5 ;allow the user to sort orders by date range, with a status of unsigned,
6 ;released/unsigned or unsigned/unreleased. It will also allow sorting by
7 ;service/section, provider, patient, location, entered by person,
8 ;or division
9 ;
10EN ;
11 N CNT,DASH,DATE,DCNT,DFN,DIR,DIRUT,DIV,DTOUT,DUOUT,EDATE,EDT
12 N HDR,HDR1,IEN,LCNT,LOC,LONER,LONUM,PAGE,PAT,PNM,PROV,QUIT,RPDT
13 N SD1,SD2,SDATE,SDT,SER,SINGLE,SORT,SSN,STOP,STATUS,SUB,SUMONLY,TOT,TOT0,TOT1
14 N TYPE,VA,VADM,VAERR,WHO,WHEN,Y
15 S U="^" K ^TMP("ORUNS",$J),^TMP("ORSTATS",$J)
16 W @IOF,!!?30,"Lapsed Orders Search",!?15,"This report is formatted for a 132 column output.",!
17TYPE S TYPE=2
18SORT ;sets DIR call to ask for the sorting criteria
19 S DIR(0)="SX^1:Service/Section;2:Provider;3:Patient;4:Location;5:Entered By;6:Division"
20 S DIR("A")="Enter the sort criteria"
21 S DIR("?")="To sort orders by Service/Section enter a 1, by Provider enter a 2, by Patient enter a 3, by Location enter a 4, by Entering Person enter a 5 and by Division enter a 6, Enter an ^ to exit the option"
22 D ^DIR S:+Y>0 SORT=+Y K DIR I $D(DTOUT)!$D(DUOUT) G EXIT
23SINGLE ;sets DIR call to ask the user if they want to sort for a single
24 ;service, provider, patient, location, division or entered by
25 S DIR(0)="Y"
26 S DIR("A")="Would you like a specific "_$S(SORT=1:"Service/Section",SORT=2:"Provider",SORT=3:"Patient",SORT=4:"Location",SORT=5:"Entering person",1:"Division")
27 S DIR("B")="NO"
28 S DIR("?")="You can limit your sort to one or more Service/Section, Provider, Patient, Location, Entered by, or Division, by entering a YES here"
29 D ^DIR S:+Y>0 SINGLE=+Y K DIR I $D(DTOUT)!$D(DUOUT) G EXIT
30LONER ;sets DIR call to allow the user to select the specific sort entity
31 ;only asked if the user entered a YES in the previous prompt
32 I $D(SINGLE) D I $D(QUIT)!('$D(LONER)) G EXIT
33 .F D I Y=-1!($D(QUIT)) Q
34 ..S DIR(0)=$S(SORT=1:"PAO^49:AEQM",SORT=2:"PAO^200:AEQM,",SORT=3:"PAO^2:AEQM",SORT=4:"PAO^44:AEQM",SORT=5:"PAO^200:AEQM",SORT=6:"PAO^40.8:AEQM")
35 ..S DIR("A")="Select "_$S(SORT=1:"Service/Section: ",SORT=2:"Provider: ",SORT=3:"Patient: ",SORT=4:"Location: ",SORT=5:"Entering Person: ",1:"Division: ")
36 ..S DIR("?")="When finished entering all the selections you want, press return or enter to go on. Enter an ^ to exit the option."
37 ..D ^DIR S:+Y>0 LONER($P(Y,U,2))=+Y K DIR I $D(DTOUT)!$D(DUOUT) S QUIT=1
38SDATE ;sets DIR call to ask the user for a starting date
39 S DIR(0)="DA^::ETX"
40 S DIR("A")="Enter a starting date: "
41 S DIR("?")="Enter the date or date/time that you want the search to start with. Example: If your site has a 48 hr grace period for signing orders, enter T-2"
42 D ^DIR S:+Y>0 (SDATE,SD1)=(9999999-Y),SDT=$$FMTE^XLFDT(Y) K DIR I $D(DTOUT)!$D(DUOUT) G EXIT
43EDATE ;sets DIR call to ask the user for an ending date (optional)
44 S DIR(0)="DA^::ETX"
45 S DIR("A")="Enter an ending date: "
46 S DIR("?")="Enter the date or date/time that you want the search to end with. This field can be used to ignore pre-CPRS unsigned orders by entering the date of your CPRS installation."
47 D ^DIR S (EDATE,SD2)=(9999999-Y),EDT=$$FMTE^XLFDT(Y) K DIR I $D(DTOUT)!$D(DUOUT) G EXIT
48SWITCH ;takes the date input from the user and does a switcheroo so the program
49 ;can work as intended
50 I EDATE'>SDATE S EDATE=SD1,SDATE=SD2
51SUMONLY ;ask if summary only or full detail
52 S DIR(0)="Y",DIR("A")="Print summary only ",DIR("B")="NO",DIR("?")="Enter yes for summary report (statistics), no for detailed report."
53 D ^DIR S SUMONLY=$S(Y=1:1,Y=0:0,1:"^") K DIR I SUMONLY="^" Q
54TASK ;
55 S %ZIS="Q" D ^%ZIS I POP Q
56 I $D(IO("Q")) D K IO("Q") Q
57 .S ZTIO=ION,ZTDESC="File 100 order status search"
58 .S ZTRTN="LOOP^ORLPSRA",ZTSAVE("SORT")="",ZTSAVE("TYPE")=""
59 .S ZTSAVE("SDATE")="",ZTSAVE("EDATE")="",ZTSAVE("SINGLE")=""
60 .S ZTSAVE("LONER*")="",ZTSAVE("SDT")="",ZTSAVE("EDT")="",ZTSAVE("SUMONLY")=""
61 .D ^%ZTLOAD I $D(ZTSK) W !,?32,"REQUEST QUEUED"
62 U IO D LOOP^ORLPSRA Q
63STATS ;SERVICE/SECTION statistics
64 S:SUMONLY PAGE=0 S SUMONLY=0 ;Set SUMONLY back to zero so header will print.
65 I '$D(^TMP("ORSTATS",$J)) D HDR Q:STOP W !,"There are no statistics for the selected sort range." Q
66 I SORT=1&($D(^TMP("ORSTATS",$J))) D
67 .S HDR="!!?25,""Order Statistics for Service/Section sort"""
68 .S HDR1="!,""Service/Section"",?25,""Provider"",?50,""# of Orders"""
69 .S TOT=0 D HDR
70 .S SER="" F S SER=$O(^TMP("ORSTATS",$J,SER)) S TOT0=0 Q:SER=""!STOP D
71 ..S PROV="" F S PROV=$O(^TMP("ORSTATS",$J,SER,PROV)) Q:PROV=""!STOP D
72 ...W SER,?25,PROV,?50,^(PROV),! S TOT1=^(PROV),TOT0=TOT0+TOT1
73 ...S TOT=TOT+TOT1 D:$Y>(IOSL-4) HDR Q:STOP
74 ..W:'STOP ?46,"SUBTOTAL: ",TOT0,!
75 .W:'STOP ?46,"------------",!?46,"TOTAL: ",TOT
76PV ;PROVIDER statistics
77 I SORT=2&($D(^TMP("ORSTATS",$J))) D
78 .S HDR="!!?25,""Order Statistics for Provider sort"""
79 .S HDR1="!,""Provider"",?25,""Patient"",?50,""# of Orders"""
80 .S TOT=0 D HDR
81 .S PROV="" F S PROV=$O(^TMP("ORSTATS",$J,PROV)) S TOT0=0 Q:PROV=""!STOP D
82 ..S PNM="" F S PNM=$O(^TMP("ORSTATS",$J,PROV,PNM)) Q:PNM=""!STOP D
83 ...W PROV,?25,PNM,?50,^(PNM),! S TOT1=^(PNM)
84 ...S TOT=TOT+TOT1,TOT0=TOT0+TOT1 D:$Y>(IOSL-4) HDR Q:STOP
85 ..W:'STOP ?46,"SUBTOTAL: ",TOT0,!
86 .W:'STOP ?46,"------------",!?46,"TOTAL: ",TOT
87PT ;PATIENT statistics
88 I SORT=3&($D(^TMP("ORSTATS",$J))) D
89 .S HDR="!!?25,""Order Statistics for Patient sort"""
90 .S HDR1="!,""Patient"",?25,""Provider"",?50,""# of Orders"""
91 .S TOT=0 D HDR
92 .S PNM="" F S PNM=$O(^TMP("ORSTATS",$J,PNM)) S TOT0=0 Q:PNM=""!STOP D
93 ..S PROV="" F S PROV=$O(^TMP("ORSTATS",$J,PNM,PROV)) Q:PROV=""!STOP D
94 ...W PNM,?25,PROV,?50,^(PROV),! S TOT1=^(PROV),TOT0=TOT0+TOT1
95 ...S TOT=TOT+TOT1 D:$Y>(IOSL-4) HDR Q:STOP
96 ..W:'STOP ?46,"SUBTOTAL: ",TOT0,!
97 .W:'STOP ?46,"------------",!?46,"TOTAL: ",TOT
98L ;LOCATION statistics
99 I SORT=4&($D(^TMP("ORSTATS",$J))) D
100 .S HDR="!!?25,""Order Statistics for Location sort"""
101 .S HDR1="!,""Location"",?25,""Provider"",?50,""# of Orders"""
102 .S TOT=0 D HDR
103 .S LOC="" F S LOC=$O(^TMP("ORSTATS",$J,LOC)) S TOT0=0 Q:LOC=""!STOP D
104 ..S PROV="" F S PROV=$O(^TMP("ORSTATS",$J,LOC,PROV)) Q:PROV=""!STOP D
105 ...W $E(LOC,1,24),?25,PROV,?50,^(PROV),! S TOT1=^(PROV),TOT0=TOT0+TOT1
106 ...S TOT=TOT+TOT1 D:$Y>(IOSL-4) HDR Q:STOP
107 ..W:'STOP ?46,"SUBTOTAL: ",TOT0,!
108 .W:'STOP ?46,"------------",!?46,"TOTAL: ",TOT
109EB ;ENTERED BY statistics
110 I SORT=5&($D(^TMP("ORSTATS",$J))) D
111 .S HDR="!!?25,""Order Statistics for Entering Person sort"""
112 .S HDR1="!,""Entering person"",?25,""Patient"",?50,""# of Orders"""
113 .S TOT=0 D HDR
114 .S WHO="" F S WHO=$O(^TMP("ORSTATS",$J,WHO)) S TOT0=0 Q:WHO=""!STOP D
115 ..S PNM="" F S PNM=$O(^TMP("ORSTATS",$J,WHO,PNM)) Q:PNM=""!STOP D
116 ...W WHO,?25,PNM,?50,^(PNM),! S TOT1=^(PNM),TOT0=TOT0+TOT1
117 ...S TOT=TOT+TOT1 D:$Y>(IOS-4) HDR Q:STOP
118 ..W:'STOP ?46,"SUBTOTAL: ",TOT0,!
119 .W:'STOP ?46,"------------",!?46,"TOTAL: ",TOT
120D ;DIVISION statistics
121 I SORT=6&($D(^TMP("ORSTATS",$J))) D
122 .S HDR="!!?25,""Order Statistics for Division sort"""
123 .S DIV="" F S DIV=$O(^TMP("ORSTATS",$J,DIV)) Q:DIV=""!STOP S DCNT=0 D
124 ..S LOC="" F S LOC=$O(^TMP("ORSTATS",$J,DIV,LOC)) Q:LOC=""!STOP S LCNT=0 D
125 ...S HDR1="!!,""Division: "",DIV,!?5,""Location: "",LOC,!?20,""Provider"",?51,""Orders""" D HDR Q:STOP
126 ...S PROV="" F S PROV=$O(^TMP("ORSTATS",$J,DIV,LOC,PROV)) Q:PROV=""!STOP D
127 ....W ?20,PROV,?51,^(PROV),! S LCNT=LCNT+^(PROV) D:$Y>(IOSL-4) HDR Q:STOP
128 ...I 'STOP W !?41,"Subtotal",?51,LCNT S DCNT=DCNT+LCNT
129 ..I 'STOP W !?5,"Total orders for Division: ",DIV_" = "_DCNT
130EXIT K ^TMP("ORUNS",$J),^TMP("ORSTATS",$J)
131 D ^%ZISC
132 Q
133LOC(LOC) ;resolves the location pointer
134 N X
135 S X=$P(^SC(+LOC,0),U)
136 Q X
137USER(USER) ;resolves user pointers
138 N X
139 S X=$E($P(^VA(200,+USER,0),U),1,24)
140 Q X
141STAT(STA) ;resolves pointer to the order status file
142 N X
143 S X=$E($P(^ORD(100.01,+STA,0),U),1,14)
144 Q X
145SER(SER) ;resolves pointer to the service/section file
146 N X
147 S X=$P(^DIC(49,+SER,0),U)
148 Q X
149DIV(LOC) ;determines the division based on the entry in file 44
150 N X
151 S X=$P(^SC(+LOC,0),U,15) I X="" Q "UNKNOWN"
152 S X=$P(^DG(40.8,X,0),U)
153 Q X
154HDR ;Print header
155 I $G(SUMONLY) Q
156 I $E(IOST)="C"&(PAGE) S DIR(0)="E" D ^DIR S:Y'=1 STOP=1 K DIR Q:STOP
157 I PAGE!('PAGE&($E(IOST)="C")) W @IOF
158 I $D(RPDT) W @RPDT
159 I $D(HDR) W @HDR
160 I $D(HDR1) W @HDR1
161 W !,$$REPEAT^XLFSTR("-",IOM),!
162 S PAGE=1
163 Q
Note: See TracBrowser for help on using the repository browser.