source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORS100.m@ 1801

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

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