1 | ORWGAPI3 ; 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 | ;
|
---|
5 | ADVERSE(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 | ;
|
---|
28 | DX(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 | ;
|
---|
56 | LAB(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 | ;
|
---|
79 | MED(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
|
---|
80 | D MED3^ORWGAPIE(.DATA,ITEM,START,DFN,.CNT,.TMP)
|
---|
81 | Q
|
---|
82 | ;
|
---|
83 | NOTE(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 | ;
|
---|
110 | ORDER(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 | ;
|
---|
125 | RAD(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 | ;
|
---|