source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWGAPI6.m@ 1211

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

initial load of WorldVistAEHR
File size: 3.4 KB
Line 
1ORWGAPI6 ; SLC/STAFF - Graph API Items, non-indexed ;12/21/05 08:16
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
3 ;
4ADMITS(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
5 N DATE,DATE2,DISCH,LINE,LST,NUM,OK,RESULT K LST
6 K ^TMP("ORWGRPC TEMP",$J)
7 D ADMITLST^ORWPT(.LST,DFN)
8 S OK=0
9 S NUM=0
10 F S NUM=$O(LST(NUM)) Q:NUM<1 D Q:OK
11 . S LINE=LST(NUM)
12 . S DATE=$P(LINE,U)
13 . S DISCH=$P(LINE,U,5)
14 . S DATE2=$$DISCH^ORWGAPIA(DISCH)
15 . I DATE2="" S DATE2=DATE2\1
16 . I FMT=6 D Q
17 .. I DATE>NEWEST Q
18 .. I DATE2>0,DATE2<OLDEST Q
19 .. I $D(^TMP("ORWGRPC TEMP",$J,"ADMIT")) Q
20 .. S ^TMP("ORWGRPC TEMP",$J,"ADMIT")=""
21 .. S CNT=CNT+1
22 .. S OK=1
23 .. S RESULT="405^ADMIT"
24 . I FMT=3 D Q
25 .. I $D(^TMP("ORWGRPC TEMP",$J,"ADMIT")) Q
26 .. S ^TMP("ORWGRPC TEMP",$J,"ADMIT")=""
27 .. S CNT=CNT+1
28 .. S OK=1
29 .. S RESULT="405^ADMIT^^ADMIT^^"_DATE
30 . I FMT=0 D Q
31 .. S ^TMP("ORWGRPC TEMP",$J,"ADMIT")=""
32 .. S CNT=CNT+1
33 .. S OK=1
34 .. S RESULT="405^ADMIT^ADMIT"
35 I OK D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
36 K ^TMP("ORWGRPC TEMP",$J)
37 Q
38 ;
39SURGERY(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
40 N CASE,DATE,PROC,RESULT,RESULTS,SURG,SURGPROC K SURG,SURGPROC
41 D SURG^ORWGAPIA(.SURG,DFN)
42 K SURG(0),SURG(1)
43 I FMT=6 D
44 . S CASE=0
45 . F S CASE=$O(SURG(CASE)) Q:CASE<1 D
46 .. S RESULTS=SURG(CASE)
47 .. S PROC=$P(RESULTS,U,3)
48 .. I '$L(PROC) Q
49 .. S DATE=$P(RESULTS,U,5)
50 .. I DATE>NEWEST Q
51 .. I DATE<OLDEST Q
52 .. I $D(SURGPROC(PROC)) Q
53 .. S SURGPROC(PROC)=""
54 .. S CNT=CNT+1
55 .. S RESULT=130_U_PROC
56 .. D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
57 I FMT'=6 D
58 . S CASE=0
59 . F S CASE=$O(SURG(CASE)) Q:CASE<1 D
60 .. S RESULTS=SURG(CASE)
61 .. S PROC=$P(RESULTS,U,3)
62 .. I '$L(PROC) Q
63 .. S SURGPROC(PROC)=RESULTS
64 . K SURG S PROC=""
65 . F S PROC=$O(SURGPROC(PROC)) Q:PROC="" D
66 .. S CNT=CNT+1
67 .. I FMT=3 S RESULT=130_U_PROC_"^^"_PROC_"^^"_$P(SURGPROC(PROC),U,5)
68 .. I FMT=0 S RESULT=130_U_PROC_U_PROC
69 .. D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
70 Q
71 ;
72VISITS(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
73 N DATE,DATE2,ITEM,NODE,NUM,OK,RESULT
74 K ^TMP("ORWGRPC TEMP",$J)
75 I FMT=6 D
76 . S DATE=0
77 . F S DATE=$O(^AUPNVSIT("AET",DFN,DATE)) Q:DATE<1 Q:DATE>NEWEST D
78 .. S ITEM=""
79 .. F S ITEM=$O(^AUPNVSIT("AET",DFN,DATE,ITEM)) Q:ITEM="" D
80 ... S NODE=""
81 ... F S NODE=$O(^AUPNVSIT("AET",DFN,DATE,ITEM,NODE)) Q:NODE="" D
82 .... S NUM=0
83 .... F S NUM=$O(^AUPNVSIT("AET",DFN,DATE,ITEM,NODE,NUM)) Q:NUM="" D
84 ..... S DATE2=+$P($G(^AUPNVSIT(NUM,0)),U,18)
85 ..... I 'DATE2 S DATE2=DATE+.01
86 ..... I +$E($P(DATE2,".",2),1,2)>24 S DATE2=(DATE\1)+.2359
87 ..... S ^TMP("ORWGRPC TEMP",$J,ITEM,DATE)=DATE2
88 . S ITEM=0
89 . F S ITEM=$O(^TMP("ORWGRPC TEMP",$J,ITEM)) Q:ITEM<1 D
90 .. S OK=0
91 .. S DATE=0
92 .. F S DATE=$O(^TMP("ORWGRPC TEMP",$J,ITEM,DATE)) Q:DATE<1 Q:DATE>NEWEST D Q:OK
93 ... S DATE2=$G(^TMP("ORWGRPC TEMP",$J,ITEM,DATE))
94 ... I DATE2<OLDEST Q
95 ... S CNT=CNT+1
96 ... S OK=1
97 ... S RESULT="9000010^"_ITEM
98 ... D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
99 I FMT'=6 D
100 . S DATE=0
101 . F S DATE=$O(^AUPNVSIT("AET",DFN,DATE)) Q:DATE<1 D
102 .. S ITEM=0
103 .. F S ITEM=$O(^AUPNVSIT("AET",DFN,DATE,ITEM)) Q:ITEM<1 D
104 ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
105 ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
106 ... S CNT=CNT+1
107 ... I FMT=3 S RESULT="9000010^"_ITEM_"^^"_$$EVALUE^ORWGAPIU(ITEM,9000010,.22)_"^^"_DATE
108 ... I FMT=0 S RESULT="9000010^"_ITEM_U_$$EVALUE^ORWGAPIU(ITEM,9000010,.22)
109 ... D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
110 K ^TMP("ORWGRPC TEMP",$J)
111 Q
112 ;
Note: See TracBrowser for help on using the repository browser.