source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWGAPI3.m@ 617

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

initial load of WorldVistAEHR
File size: 5.1 KB
RevLine 
[613]1ORWGAPI3 ; SLC/STAFF - Graph Data ;12/21/05 08:17
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243**;Dec 17, 1997;Build 242
3 ;
4 ;
5ADVERSE(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
6 N ADVERSE,DATE,DATE2,NODE,RESULT,RXN,VALUE
7 S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
8 S ADVERSE=""
9 S VALUE=ITEM_U_ITEM
10 S NODE=""
11 F S NODE=$O(^GMR(120.8,"B",DFN,NODE)) Q:NODE="" D
12 . I '$D(^GMR(120.8,NODE,0)) Q
13 . I $G(^GMR(120.8,NODE,"ER")) Q ; entered in error
14 . I '$P(^GMR(120.8,NODE,0),U,12) Q ; signed
15 . S DATE=+$P($G(^GMR(120.8,NODE,0)),U,4) I 'DATE Q
16 . I DATE>START Q
17 . I DATE<BACKTO Q
18 . I ITEM'=$P(^GMR(120.8,NODE,0),U,2) Q
19 . S RXN=0
20 . F S RXN=$O(^GMR(120.8,NODE,10,"B",RXN)) Q:RXN<1 D
21 .. S ADVERSE=ADVERSE_$$EVALUE^ORWGAPIU(RXN,120.8)_", "
22 . I $L(ADVERSE)>0 S ADVERSE=$E(ADVERSE,1,$L(ADVERSE)-2)
23 . S CNT=CNT+1
24 . S RESULT=120.8_U_ITEM_U_DATE_U_DATE2_U_ADVERSE
25 . D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
26 Q
27 ;
28DX(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
29 N DATE,DATE2,NODE,NUM,RESULT,VALUE,VALUES K VALUE
30 K ^TMP("ORWGRPC TEMP",$J)
31 S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
32 S NUM=""
33 F S NUM=$O(^PXRMINDX(45,"ICD9","PNI",DFN,NUM)) Q:NUM="" D
34 . S DATE=""
35 . F S DATE=$O(^PXRMINDX(45,"ICD9","PNI",DFN,NUM,ITEM,DATE)) Q:DATE="" D
36 .. I DATE>START Q
37 .. I DATE<BACKTO Q
38 .. S NODE=""
39 .. F S NODE=$O(^PXRMINDX(45,"ICD9","PNI",DFN,NUM,ITEM,DATE,NODE)) Q:NODE="" D
40 ... I '$D(^TMP("ORWGRPC TEMP",$J,ITEM,DATE)) S ^TMP("ORWGRPC TEMP",$J,ITEM,DATE)=NODE_U_NUM
41 S ITEM=""
42 F S ITEM=$O(^TMP("ORWGRPC TEMP",$J,ITEM)) Q:ITEM="" D
43 . S DATE=""
44 . F S DATE=$O(^TMP("ORWGRPC TEMP",$J,ITEM,DATE)) Q:DATE="" D
45 .. S NODE=$G(^TMP("ORWGRPC TEMP",$J,ITEM,DATE)) I '$L(NODE) Q
46 .. S NUM=$P(NODE,U,2)
47 .. S NODE=$P(NODE,U)
48 .. I '$L($G(^DGPT(+NODE,0))) Q ; ****** remove this when PTF patch is released **********
49 .. D PTF^ORWGAPIA(NODE,.VALUE,.VALUES) S VALUE=$$EXT^ORWGAPIX($G(VALUE("DISCHARGE STATUS")),45,6)
50 .. I NUM="DXLS" S VALUE="(DXLS) "_VALUE_U_U_VALUES ;*****************************
51 .. S RESULT=45_"DX"_U_ITEM_U_DATE_U_DATE2_U_" "_VALUE
52 .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
53 K ^TMP("ORWGRPC TEMP",$J)
54 Q
55 ;
56LAB(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
57 N COMMENT,DATE,DATE2,NODE,RESULT,TYPE,VALUE K VALUE
58 S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
59 D
60 . I $E(ITEM)="A" S TYPE="AP" Q
61 . I $E(ITEM)="M" S TYPE="MI" Q
62 . S TYPE="" Q
63 F S DATE=$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE)) Q:DATE="" D
64 . I DATE>START Q
65 . I DATE<BACKTO Q
66 . S NODE=""
67 . F S NODE=$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
68 .. K VALUE
69 .. D LAB^ORWGAPIC(.VALUE,NODE,ITEM)
70 .. I TYPE="AP" S RESULT="63AP^"_ITEM_U_DATE_U_DATE2 ;_U_$P(VALUE,U,2)
71 .. I TYPE="MI" S RESULT="63MI^"_ITEM_U_DATE_U_DATE2_U_$P(VALUE,U,4)
72 .. I TYPE="" D
73 ... S COMMENT=""
74 ... I $L($G(VALUE("COMMENTS",1))) S COMMENT=1
75 ... S RESULT="63^"_ITEM_U_DATE_U_DATE2_U_$P(VALUE,U,3)_U_$P(VALUE,U,4)_U_$G(VALUE("SPECIMEN"))_U_COMMENT
76 .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
77 Q
78 ;
79MED(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
80 D MED3^ORWGAPIE(.DATA,ITEM,START,DFN,.CNT,.TMP)
81 Q
82 ;
83NOTE(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
84 N DATE,DOC,DOCCLASS,DOCTYPE,DUM,IEN,RESULT,RESULTS,TITLE,VALUE K DUM
85 K ^TMP("ORWGRPC TEMP",$J),^TMP("TIUR",$J)
86 S CNT=$G(CNT),ITEM=$$UP^ORWGAPIX(ITEM),BACKTO=+$G(BACKTO)
87 F DOCTYPE="P","D","C" D
88 . S DOCCLASS=$$DOCCLASS^ORWGAPIA(DOCTYPE)
89 . K ^TMP("TIUR",$J)
90 . D TIU^ORWGAPIA(.DUM,DOCCLASS,5,DFN)
91 . S DOC=0
92 . F S DOC=$O(^TMP("TIUR",$J,DOC)) Q:DOC<1 D
93 .. S RESULTS=^TMP("TIUR",$J,DOC)
94 .. S IEN=+$P(RESULTS,U)
95 .. S TITLE=$$UP^ORWGAPIX($P(RESULTS,U,2))
96 .. I TITLE'=ITEM Q
97 .. ; do not use admission date S DATE=$P($G(^AUPNVSIT(+$P($G(^TIU(8925,IEN,0)),U,3),0)),U)
98 .. S DATE=$P(RESULTS,U,3)
99 .. I DATE>START Q
100 .. I DATE<BACKTO Q
101 .. S VALUE=$P(RESULTS,U,7)
102 .. S CNT=CNT+1
103 .. S RESULT=8925_U_TITLE_U_DATE_"^^"_VALUE
104 .. I $D(^TMP("ORWGRPC TEMP",$J,RESULT)) Q
105 .. S ^TMP("ORWGRPC TEMP",$J,RESULT)=""
106 .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
107 K ^TMP("ORWGRPC TEMP",$J),^TMP("TIUR",$J)
108 Q
109 ;
110ORDER(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
111 N DATE,DATE2,NODE,ORUPCHUK,RESULT,VALUE K ORUPCHUK
112 S DATE="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
113 F S DATE=$O(^PXRMINDX(100,"PI",DFN,ITEM,DATE)) Q:DATE="" D
114 . I DATE>START Q
115 . I DATE<BACKTO Q
116 . S DATE2=""
117 . F S DATE2=$O(^PXRMINDX(100,"PI",DFN,ITEM,DATE,DATE2)) Q:DATE2="" D
118 .. S NODE=""
119 .. F S NODE=$O(^PXRMINDX(100,"PI",DFN,ITEM,DATE,DATE2,NODE)) Q:NODE="" D
120 ... D EN^ORX8($P(NODE,";")) S VALUE=$P($G(ORUPCHUK("ORSTS")),U,2)
121 ... S RESULT=100_U_ITEM_U_DATE_"^^"_VALUE
122 ... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
123 Q
124 ;
125RAD(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
126 N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
127 S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
128 F S DATE=$O(^PXRMINDX(70,"PI",DFN,ITEM,DATE)) Q:DATE="" D
129 . I DATE>START Q
130 . I DATE<BACKTO Q
131 . S NODE=""
132 . F S NODE=$O(^PXRMINDX(70,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
133 .. D RAD^ORWGAPIA(NODE,.VALUE,.VALUES) S VALUE=$G(VALUE("PDX"))_"-"_$G(VALUE("EXAM STATUS"))_U_U_VALUES
134 .. S RESULT=70_U_ITEM_U_DATE_U_DATE2_U_VALUE
135 .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
136 Q
137 ;
Note: See TracBrowser for help on using the repository browser.