source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORS100A.m@ 1540

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

initial load of FOIAVistA 6/30/08 version
File size: 8.3 KB
Line 
1ORS100A ;SLC/RAF - Continuation of ORS100 ;10/20/00 14:47
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**50**;Dec 17, 1997
3 ;
4LOOP ;called from ORS100
5 ;goes thru the "AS" xref in 100 for order dates - called from ORS100
6 S RPDT="""Report Date: "",$$FMTE^XLFDT($$NOW^XLFDT),"" Sort Range From: "",SDT,"" To: "",EDT",STOP=0
7 S PAT="" F S PAT=$O(^OR(100,"AS",PAT)) Q:'PAT!STOP D
8 .Q:$P(^DPT(+PAT,0),U,21) ;Quit if test patient
9 .S DATE=0 F S DATE=$O(^OR(100,"AS",PAT,DATE)) Q:'DATE!STOP I DATE>SDATE,DATE<EDATE D
10 ..S IEN=0 F S IEN=$O(^OR(100,"AS",PAT,DATE,IEN)) Q:'IEN!STOP D
11 ...S SUB=0 F S SUB=$O(^OR(100,"AS",PAT,DATE,IEN,SUB)) Q:'SUB!STOP D
12 ....I $D(^OR(100,IEN,8,SUB,0)),'$L($P(^(0),"^",6)) D
13 .....I TYPE=1 Q:+$P(^(0),U,15)=11
14 .....I TYPE=3 Q:+$P(^(0),U,15)'=11
15 .....S (LOC,DIV)="**DELAYED ORDER/NOT ENTERED" ;Reset values as delayed orders may not have these values yet
16 .....I $D(^VA(200,+$P(^OR(100,IEN,8,SUB,0),U,3),0)) S PROV=$$USER^ORS100(+$P(^OR(100,IEN,8,SUB,0),U,3))
17 .....I $D(^VA(200,+$P(^OR(100,IEN,8,SUB,0),U,3),5)),$L($P(^(5),U)) S SER=$$SER^ORS100(+$P(^VA(200,+$P(^OR(100,IEN,8,SUB,0),U,3),5),U))
18 .....E S SER="MISSING from file 200"
19 .....I $D(^VA(200,+$P(^OR(100,IEN,8,SUB,0),U,13))) S WHO=$$USER^ORS100(+$P(^OR(100,IEN,8,SUB,0),U,13))
20 .....I $G(^OR(100,IEN,6)) I $P(^(6),U)=9&($P(^(6),U,5)="AUTO DC") S WHO=$$USER^ORS100(+$P(^OR(100,IEN,8,1,0),U,13)) ;If DCd nature is auto and text is auto dc set entered by to original entry person
21 .....S DFN=+$P(^OR(100,IEN,0),U,2) D DEM^VADPT S SSN=VA("BID"),PNM=$E(VADM(1),1,24)
22 .....I $D(^OR(100,IEN,3)),$P(^(3),U,3) S STATUS=$$STAT^ORS100(+$P(^(3),U,3))
23 .....I $D(^OR(100,IEN,0)),$P(^(0),U,10) S LOC=$$LOC^ORS100(+$P(^(0),U,10))
24 .....I $D(^OR(100,IEN,0)),$P(^(0),U,10) S DIV=$$DIV^ORS100(+$P(^(0),U,10))
25 .....I $D(^OR(100,IEN,8,SUB,0)),$P(^(0),U) S WHEN=$$FMTE^XLFDT($P($P(^(0),U),"."))
26 .....I SORT=1 S ^TMP("ORUNS",$J,SER,PROV,IEN)=SER_U_PROV_U_WHO_U_PNM_U_SSN_U_STATUS_U_IEN_U_WHEN
27 .....I SORT=2 S ^TMP("ORUNS",$J,PROV,PNM,IEN)=PROV_U_WHO_U_PNM_U_SSN_U_STATUS_U_IEN_U_WHEN
28 .....I SORT=3 S ^TMP("ORUNS",$J,PNM,PROV,IEN)=PNM_U_SSN_U_PROV_U_WHO_U_STATUS_U_IEN_U_WHEN
29 .....I SORT=4 S ^TMP("ORUNS",$J,LOC,PROV,IEN)=LOC_U_PROV_U_WHO_U_PNM_U_SSN_U_STATUS_U_IEN_U_WHEN
30 .....I SORT=5 S ^TMP("ORUNS",$J,WHO,PNM,IEN)=WHO_U_PROV_U_PNM_U_SSN_U_STATUS_U_IEN_U_WHEN
31 .....I SORT=6 S ^TMP("ORUNS",$J,DIV,LOC,PROV,IEN)=DIV_U_LOC_U_PROV_U_WHO_U_PNM_U_SSN_U_STATUS_U_IEN_U_WHEN
32PROV ;loops thru the TMP global for output sort by provider
33 I SORT=2&('$D(LONER)) D
34 .I TYPE=1 S HDR="!!?30,""List of RELEASED but UNSIGNED orders by PROVIDER"""
35 .I TYPE=2 S HDR="!!?40,""List of UNSIGNED orders by PROVIDER"""
36 .I TYPE=3 S HDR="!!?30,""List of UNSIGNED/UNRELEASED orders by PROVIDER"""
37 .S HDR1="!!,""PROVIDER"",?25,""ENTERED BY"",?50,""PATIENT"",?75,""SSN"",?81,""STATUS"",?95,""ORDER #"",?110,""ORDER DATE"""
38 .S PAGE=0 D HDR^ORS100
39 .I '$D(^TMP("ORUNS",$J)) W !,"No unsigned orders found" Q
40 .S PROV="" F S PROV=$O(^TMP("ORUNS",$J,PROV)) Q:PROV=""!STOP D
41 ..S PNM="" F S PNM=$O(^TMP("ORUNS",$J,PROV,PNM)) S CNT=0 Q:PNM=""!STOP D
42 ...S IEN=0 F S IEN=$O(^TMP("ORUNS",$J,PROV,PNM,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
43 ....I 'SUMONLY W $P(^(IEN),U),?25,$P(^(IEN),U,2),?50,$P(^(IEN),U,3),?75,$P(^(IEN),U,4),?81,$P(^(IEN),U,5),?95,$P(^(IEN),U,6),?110,$P(^(IEN),U,7),! D:$Y>(IOSL-4) HDR^ORS100 Q:STOP
44 ....S ^TMP("ORSTATS",$J,PROV,PNM)=CNT
45SPROV ;sorts for a single provider
46 I SORT=2&($D(LONER)) S LONER="",PAGE=0 F S LONER=$O(LONER(LONER)) Q:LONER=""!STOP D
47 .I TYPE=1 S HDR="!!?30,""List of RELEASED but UNSIGNED orders for "",LONER"
48 .I TYPE=2 S HDR="!!?30,""List of UNSIGNED orders for "",LONER"
49 .I TYPE=3 S HDR="!!?30,""List of UNSIGNED/UNRELEASED orders for "",LONER"
50 .S HDR1="!!,""PROVIDER"",?25,""ENTERED BY"",?50,""PATIENT"",?75,""SSN"",?81,""STATUS"",?95,""ORDER #"",?110,""ORDER DATE"""
51 .D HDR^ORS100
52 .S PROV=LONER I $D(^TMP("ORUNS",$J,PROV)) D
53 ..S PNM="" F S PNM=$O(^TMP("ORUNS",$J,PROV,PNM)) S CNT=0 Q:PNM=""!STOP D
54 ...S IEN=0 F S IEN=$O(^TMP("ORUNS",$J,PROV,PNM,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
55 ....I 'SUMONLY W $P(^(IEN),U),?25,$P(^(IEN),U,2),?50,$P(^(IEN),U,3),?75,$P(^(IEN),U,4),?81,$P(^(IEN),U,5),?95,$P(^(IEN),U,6),?110,$P(^(IEN),U,7),! D:$Y>(IOSL-4) HDR^ORS100 Q:STOP
56 ....S ^TMP("ORSTATS",$J,PROV,PNM)=CNT
57 .I '$D(^TMP("ORUNS",$J,PROV)) W !!,"No unsigned orders found for "_LONER
58PAT ;loops thru the TMP global for output sort by patient
59 I SORT=3&('$D(LONER)) D
60 .I TYPE=1 S HDR="!!?30,""List of RELEASED but UNSIGNED orders by PATIENT"""
61 .I TYPE=2 S HDR="!!?40,""List of UNSIGNED orders by PATIENT"""
62 .I TYPE=3 S HDR="!!?30,""List of UNSIGNED/UNRELEASED orders by PATIENT"""
63 .S HDR1="!!,""PATIENT"",?25,""SSN"",?30,""PROVIDER"",?55,""ENTERED BY"",?81,""STATUS"",?95,""ORDER #"",?110,""ORDER DATE"""
64 .S PAGE=0 D HDR^ORS100
65 .I '$D(^TMP("ORUNS",$J)) W !,"No unsigned orders found" Q
66 .S PNM="" F S PNM=$O(^TMP("ORUNS",$J,PNM)) Q:PNM=""!STOP D
67 ..S PROV="" F S PROV=$O(^TMP("ORUNS",$J,PNM,PROV)) S CNT=0 Q:PROV=""!STOP D
68 ...S IEN=0 F S IEN=$O(^TMP("ORUNS",$J,PNM,PROV,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
69 ....I 'SUMONLY W $P(^(IEN),U),?25,$P(^(IEN),U,2),?30,$P(^(IEN),U,3),?55,$P(^(IEN),U,4),?81,$P(^(IEN),U,5),?95,$P(^(IEN),U,6),?110,$P(^(IEN),U,7),! D:$Y>(IOSL-4) HDR^ORS100 Q:STOP
70 ....S ^TMP("ORSTATS",$J,PNM,PROV)=CNT
71 ....;I $E(IOST)="E",$Y>(IOSL-105) W @IOF,@HDR
72SPAT ;sorts for a single patient
73 I SORT=3&($D(LONER)) S LONER="",PAGE=0 F S LONER=$O(LONER(LONER)) Q:LONER=""!STOP D
74 .I TYPE=1 S HDR="!!?30,""List of RELEASED but UNSIGNED orders for "",LONER"
75 .I TYPE=2 S HDR="!!?30,""List of UNSIGNED orders for "",LONER"
76 .I TYPE=3 S HDR="!!?30,""List of UNSIGNED/UNRELEASED orders for "",LONER"
77 .S HDR1="!!,""PATIENT"",?25,""SSN"",?30,""PROVIDER"",?55,""ENTERED BY"",?81,""STATUS"",?95,""ORDER #"",?110,""ORDER DATE"""
78 .D HDR^ORS100
79 .S PNM=LONER I $D(^TMP("ORUNS",$J,PNM)) D
80 ..S PROV="" F S PROV=$O(^TMP("ORUNS",$J,PNM,PROV)) S CNT=0 Q:PROV=""!STOP D
81 ...S IEN=0 F S IEN=$O(^TMP("ORUNS",$J,PNM,PROV,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
82 ....I 'SUMONLY W $P(^(IEN),U),?25,$P(^(IEN),U,2),?30,$P(^(IEN),U,3),?55,$P(^(IEN),U,4),?81,$P(^(IEN),U,5),?95,$P(^(IEN),U,6),?110,$P(^(IEN),U,7),! D:$Y>(IOSL-4) HDR^ORS100 Q:STOP
83 ....S ^TMP("ORSTATS",$J,PNM,PROV)=CNT
84 .I '$D(^TMP("ORUNS",$J,PNM)) W !!,"No unsigned orders found for "_LONER
85WARD ;loops thru the TMP global for output sort by location
86 I SORT=4&('$D(LONER)) D
87 .I TYPE=1 S HDR="!!?30,""List of RELEASED but UNSIGNED orders by LOCATION"""
88 .I TYPE=2 S HDR="!!?30,""List of UNSIGNED orders by LOCATION"""
89 .I TYPE=3 S HDR="!!?30,""List of UNSIGNED/UNRELEASED orders by LOCATION"""
90 .S HDR1="!!,""PROVIDER"",?25,""ENTERED BY"",?50,""PATIENT"",?75,""SSN"",?81,""STATUS"",?95,""ORDER #"",?110,""ORDER DATE"""
91 .S PAGE=0 D HDR^ORS100
92 .I '$D(^TMP("ORUNS",$J)) W !,"No unsigned orders found" Q
93 .S LOC="" F S LOC=$O(^TMP("ORUNS",$J,LOC)) Q:LOC=""!STOP W:'SUMONLY "Location: ",LOC,! D
94 ..S PROV="" F S PROV=$O(^TMP("ORUNS",$J,LOC,PROV)) S CNT=0 Q:PROV=""!STOP D
95 ...S IEN=0 F S IEN=$O(^TMP("ORUNS",$J,LOC,PROV,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
96 ....I 'SUMONLY W $P(^TMP("ORUNS",$J,LOC,PROV,IEN),U,2),?25,$P(^(IEN),U,3),?50,$P(^(IEN),U,4),?75,$P(^(IEN),U,5),?81,$P(^(IEN),U,6),?95,$P(^(IEN),U,7),?110,$P(^(IEN),U,8),! D:$Y>(IOSL-4) HDR^ORS100 Q:STOP
97 ....S ^TMP("ORSTATS",$J,LOC,PROV)=CNT
98 ..W !
99 ;
100SWARD ;sorts for a single location
101 I SORT=4&($D(LONER)) S LONER="",PAGE=0 F S LONER=$O(LONER(LONER)) Q:LONER=""!STOP D
102 .I TYPE=1 S HDR="!!?30,""List of RELEASED but UNSIGNED orders for "",LONER"
103 .I TYPE=2 S HDR="!!?30,""List of UNSIGNED orders for "",LONER"
104 .I TYPE=3 S HDR="!!?30,""List of UNSIGNED/UNRELEASED orders for "",LONER"
105 .S HDR1="!!,""PROVIDER"",?25,""ENTERED BY"",?50,""PATIENT"",?75,""SSN"",?81,""STATUS"",?95,""ORDER #"",?110,""ORDER DATE"""
106 .D HDR^ORS100
107 .S LOC=LONER I $D(^TMP("ORUNS",$J,LOC)) D
108 ..S PROV="" F S PROV=$O(^TMP("ORUNS",$J,LOC,PROV)) S CNT=0 Q:PROV=""!STOP D
109 ...S IEN=0 F S IEN=$O(^TMP("ORUNS",$J,LOC,PROV,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
110 ....I 'SUMONLY W $P(^TMP("ORUNS",$J,LOC,PROV,IEN),U,2),?25,$P(^(IEN),U,3),?50,$P(^(IEN),U,4),?75,$P(^(IEN),U,5),?81,$P(^(IEN),U,6),?95,$P(^(IEN),U,7),?110,$P(^(IEN),U,8),! D:$Y>(IOSL-4) HDR^ORS100 Q:STOP
111 ....S ^TMP("ORSTATS",$J,LOC,PROV)=CNT
112 .I '$D(^TMP("ORUNS",$J,LOC)) W !!,"No unsigned orders found for "_LONER
113 I SORT=1 D SERV^ORS100B
114 I SORT=5 D WHO^ORS100B
115 I SORT=6 D DIV^ORS100B
116 I 'STOP D STATS^ORS100
117EXIT K ^TMP("ORUNS",$J),^TMP("ORSTATS",$J)
118 D ^%ZISC
119 Q
Note: See TracBrowser for help on using the repository browser.