source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORLPSRB.m@ 1384

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

initial load of WorldVistAEHR
File size: 6.4 KB
RevLine 
[613]1ORLPSRB ;SLC/RAF - Continuation of ORLPSRA ; 3/31/08 6:23am
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
3 ;
4WHO ;loops thru the TMP global for output sort by entering person
5 I SORT=5&('$D(LONER)) D
6 .I TYPE=1 S HDR="!!?30,""List of RELEASED but UNSIGNED orders by ENTERING PERSON"""
7 .I TYPE=2 S HDR="!!?40,""List of LAPSED orders by ENTERING PERSON"""
8 .I TYPE=3 S HDR="!!?30,""List of UNSIGNED/UNRELEASED orders by ENTERING PERSON"""
9 .S HDR1="!!,""ENTERED BY"",?23,""PROVIDER"",?46,""PATIENT"",?71,""SSN"",?77,""STATUS"",?87,""ORDER #"",?100,""ORDER DATE"",?118,""LAPSE DATE"""
10 .S PAGE=0 D HDR^ORLPSR
11 .I '$D(^TMP("ORUNS",$J)) W !,"No lapsed orders found" Q
12 .S WHO="" F S WHO=$O(^TMP("ORUNS",$J,WHO)) Q:WHO=""!STOP D
13 ..S PNM="" F S PNM=$O(^TMP("ORUNS",$J,WHO,PNM)) S CNT=0 Q:PNM=""!STOP D
14 ...S IEN=0 F S IEN=$O(^TMP("ORUNS",$J,WHO,PNM,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
15 ....I 'SUMONLY W $P(^(IEN),U),?23,$P(^(IEN),U,2),?46,$P(^(IEN),U,3),?71,$P(^(IEN),U,4),?77,$P(^(IEN),U,5),?87,$P(^(IEN),U,6),?100,$P(^(IEN),U,7),?118,$P(^(IEN),U,8),! D:$Y>(IOSL-4) HDR^ORLPSR Q:STOP
16 ....S ^TMP("ORSTATS",$J,WHO,PNM)=CNT
17SWHO ;sorts for a single provider/entering person
18 I SORT=5&($D(LONER)) S LONER="",PAGE=0 F S LONER=$O(LONER(LONER)) Q:LONER=""!STOP D
19 .I TYPE=1 S HDR="!!?30,""List of RELEASED but UNSIGNED orders for "",LONER"
20 .I TYPE=2 S HDR="!!?30,""List of LAPSED orders for "",LONER"
21 .I TYPE=3 S HDR="!!?30,""List of UNSIGNED/UNRELEASED orders for "",LONER"
22 .S HDR1="!!,""ENTERED BY"",?23,""PROVIDER"",?46,""PATIENT"",?71,""SSN"",?77,""STATUS"",?87,""ORDER #"",?100,""ORDER DATE"",?118,""LAPSE DATE"""
23 .D HDR^ORLPSR
24 .S WHO=LONER I $D(^TMP("ORUNS",$J,WHO)) D
25 ..S PNM="" F S PNM=$O(^TMP("ORUNS",$J,WHO,PNM)) S CNT=0 Q:PNM=""!STOP D
26 ...S IEN=0 F S IEN=$O(^TMP("ORUNS",$J,WHO,PNM,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
27 ....I 'SUMONLY W $P(^(IEN),U),?23,$P(^(IEN),U,2),?46,$P(^(IEN),U,3),?71,$P(^(IEN),U,4),?77,$P(^(IEN),U,5),?87,$P(^(IEN),U,6),?100,$P(^(IEN),U,7),?118,$P(^(IEN),U,8),! D:$Y>(IOSL-4) HDR^ORLPSR Q:STOP
28 ....S ^TMP("ORSTATS",$J,WHO,PNM)=CNT
29 .I '$D(^TMP("ORUNS",$J,WHO)) W !!,"No lapsed orders found for "_LONER
30DIV ;loops thru the TMP global for output sort by division
31 I SORT=6&('$D(LONER)) D
32 .I TYPE=1 S HDR="!!?30,""List of RELEASED but UNSIGNED orders by DIVISION"""
33 .I TYPE=2 S HDR="!!?30,""List of LAPSED orders by DIVISION"""
34 .I TYPE=3 S HDR="!!?30,""List of UNSIGNED/UNRELEASED orders by DIVISION"""
35 .S HDR1="!!?15,""ENTERED BY"",?40,""PATIENT"",?65,""SSN"",?71,""STATUS"",?90,""ORDER #"",?102,""ORDER DATE"",?118,""LAPSE DATE"""
36 .S PAGE=0 D HDR^ORLPSR
37 .I '$D(^TMP("ORUNS",$J)) W !,"No lapsed orders found" Q
38 .S DIV="" F S DIV=$O(^TMP("ORUNS",$J,DIV)) Q:DIV=""!STOP W:'SUMONLY "Division: ",DIV D
39 ..S LOC="" F S LOC=$O(^TMP("ORUNS",$J,DIV,LOC)) Q:LOC=""!STOP W:'SUMONLY !?5,"Location: ",LOC D
40 ...S PROV="" F S PROV=$O(^TMP("ORUNS",$J,DIV,LOC,PROV)) Q:PROV=""!STOP W:'SUMONLY !?10,"Provider: ",PROV,! S CNT=0 D
41 ....S IEN=0 F S IEN=$O(^TMP("ORUNS",$J,DIV,LOC,PROV,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
42 .....W:'SUMONLY ?15,$S(PROV'=$P(^TMP("ORUNS",$J,DIV,LOC,PROV,IEN),U,4):$P(^(IEN),U,4),1:""),?40,$P(^(IEN),U,5),?65,$P(^(IEN),U,6),?71,$P(^(IEN),U,7),?90,$P(^(IEN),U,8),?102,$P(^(IEN),U,9),?118,$P(^(IEN),U,10),! D:$Y>(IOSL-4) HDR^ORLPSR Q:STOP
43 .....S ^TMP("ORSTATS",$J,DIV,LOC,PROV)=CNT
44SDIV ;sorts for a single division
45 I SORT=6&($D(LONER)) S LONER="",PAGE=0 F S LONER=$O(LONER(LONER)) Q:LONER=""!STOP D
46 .I TYPE=1 S HDR="!!?30,""List of RELEASED but UNSIGNED orders for "",LONER"
47 .I TYPE=2 S HDR="!!?30,""List of LAPSED orders for "",LONER"
48 .I TYPE=3 S HDR="!!?30,""List of UNSIGNED/UNRELEASED orders for "",LONER"
49 .S HDR1="!!,""PROVIDER"",?23,""ENTERED BY"",?46,""PATIENT"",?69,""SSN"",?72,""STATUS"",?87,""ORDER #"",?100,""ORDER DATE"",?116,""LAPSE DATE"""
50 .D HDR^ORLPSR
51 .S DIV=LONER I $D(^TMP("ORUNS",$J,DIV)) D
52 ..S LOC="" F S LOC=$O(^TMP("ORUNS",$J,DIV,LOC)) Q:LOC=""!STOP W:'SUMONLY ?5,"Location: ",LOC,! D W:'SUMONLY !
53 ...S PROV="" F S PROV=$O(^TMP("ORUNS",$J,DIV,LOC,PROV)) S CNT=0 Q:PROV=""!STOP D
54 ....S IEN="" F S IEN=$O(^TMP("ORUNS",$J,DIV,LOC,PROV,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
55 .....W:'SUMONLY $P(^(IEN),U,3),?23,$P(^(IEN),U,4),?46,$P(^(IEN),U,5),?69,$P(^(IEN),U,6),?72,$P(^(IEN),U,7),?87,$P(^(IEN),U,8),?100,$P(^(IEN),U,9),?116,$P(^(IEN),U,10),! D:$Y>(IOSL-4) HDR^ORLPSR Q:STOP
56 .....S ^TMP("ORSTATS",$J,DIV,LOC,PROV)=CNT
57 .I '$D(^TMP("ORUNS",$J,DIV)) W !!,"No lapsed orders found for "_LONER
58SERV ;loops thru the TMP global for output sort by service
59 I SORT=1&('$D(LONER)) D
60 .I TYPE=1 S HDR="!!?30,""List of RELEASED but UNSIGNED orders by SERVICE/SECTION"""
61 .I TYPE=2 S HDR="!!?30,""List of LAPSED orders by SERVICE/SECTION"""
62 .I TYPE=3 S HDR="!!?30,""List of UNSIGNED/UNRELEASED orders by SERVICE/SECTION"""
63 .S HDR1="!!,""PROVIDER"",?23,""ENTERED BY"",?46,""PATIENT"",?71,""SSN"",?77,""STATUS"",?87,""ORDER #"",?104,""ORDER DATE"",?120,""LAPSE DATE"""
64 .S PAGE=0 D HDR^ORLPSR
65 .I '$D(^TMP("ORUNS",$J)) W !,"No lapsed orders found" Q
66 .S SER="" F S SER=$O(^TMP("ORUNS",$J,SER)) Q:SER=""!STOP W:'SUMONLY "Service/Section: ",SER,! D W:'SUMONLY !
67 ..S PROV="" F S PROV=$O(^TMP("ORUNS",$J,SER,PROV)) S CNT=0 Q:PROV=""!STOP D
68 ...S IEN=0 F S IEN=$O(^TMP("ORUNS",$J,SER,PROV,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
69 ....W:'SUMONLY $P(^TMP("ORUNS",$J,SER,PROV,IEN),U,2),?23,$P(^(IEN),U,3),?46,$P(^(IEN),U,4),?71,$P(^(IEN),U,5),?77,$P(^(IEN),U,6),?87,$P(^(IEN),U,7),?104,$P(^(IEN),U,8),?120,$P(^(IEN),U,9),! D:$Y>(IOSL-4) HDR^ORLPSR Q:STOP
70 ....S ^TMP("ORSTATS",$J,SER,PROV)=CNT
71SSERV ;sorts for a single service/section
72 I SORT=1&($D(LONER)) S LONER="",PAGE=0 F S LONER=$O(LONER(LONER)) Q:LONER=""!STOP D
73 .I TYPE=1 S HDR="!!?30,""List of RELEASED but UNSIGNED orders for "",LONER"
74 .I TYPE=2 S HDR="!!?30,""List of LAPSED orders for "",LONER"
75 .I TYPE=3 S HDR="!!?30,""List of UNSIGNED/UNRELEASED orders for "",LONER"
76 .S HDR1="!!,""PROVIDER"",?23,""ENTERED BY"",?46,""PATIENT"",?71,""SSN"",?77,""STATUS"",?87,""ORDER #"",?104,""ORDER DATE"",?120,""LAPSE DATE"""
77 .D HDR^ORLPSR
78 .S SER=LONER I $D(^TMP("ORUNS",$J,SER)) D
79 ..S PROV="" F S PROV=$O(^TMP("ORUNS",$J,SER,PROV)) S CNT=0 Q:PROV=""!STOP D
80 ...S IEN=0 F S IEN=$O(^TMP("ORUNS",$J,SER,PROV,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
81 ....W:'SUMONLY $P(^(IEN),U,2),?23,$P(^(IEN),U,3),?46,$P(^(IEN),U,4),?71,$P(^(IEN),U,5),?77,$P(^(IEN),U,6),?87,$P(^(IEN),U,7),?104,$P(^(IEN),U,8),?120,$P(^(IEN),U,9),! D:$Y>(IOSL-4) HDR^ORLPSR Q:STOP
82 ....S ^TMP("ORSTATS",$J,SER,PROV)=CNT
83 .I '$D(^TMP("ORUNS",$J,SER)) W !!,"No lapsed orders found for "_LONER
84 Q
Note: See TracBrowser for help on using the repository browser.