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

ORWGAPI3 ; SLC/STAFF - Graph Data ;12/21/05  08:17
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
 ;
 ; 
ADVERSE(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N ADVERSE,DATE,DATE2,NODE,RESULT,RXN,VALUE
 S DATE="",DATE2="",CNT=$G(CNT)
 S ADVERSE=""
 S VALUE=ITEM_U_ITEM
 S NODE=""
 F  S NODE=$O(^GMR(120.8,"B",DFN,NODE)) Q:NODE=""  D
 . I '$D(^GMR(120.8,NODE,0)) Q
 . I $G(^GMR(120.8,NODE,"ER")) Q  ; entered in error
 . I '$P(^GMR(120.8,NODE,0),U,12) Q  ; signed
 . S DATE=+$P($G(^GMR(120.8,NODE,0)),U,4) I 'DATE Q
 . I DATE>START Q
 . I ITEM'=$P(^GMR(120.8,NODE,0),U,2) Q
 . S RXN=0
 . F  S RXN=$O(^GMR(120.8,NODE,10,"B",RXN)) Q:RXN<1  D
 .. S ADVERSE=ADVERSE_$$EVALUE^ORWGAPIU(RXN,120.8)_", "
 . I $L(ADVERSE)>0 S ADVERSE=$E(ADVERSE,1,$L(ADVERSE)-2)
 . S CNT=CNT+1
 . S RESULT=120.8_U_ITEM_U_DATE_U_DATE2_U_ADVERSE
 . D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 Q
 ;
BCMA(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N DATE,NODE,RESULT,VALUE
 S DATE="",CNT=$G(CNT)
 F  S DATE=$O(^PSB(53.79,"AOIP",DFN,ITEM,DATE)) Q:DATE=""  D
 . I DATE>START Q
 . S NODE=""
 . F  S NODE=$O(^PSB(53.79,"AOIP",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
 .. S VALUE=$P($G(^PSB(53.79,NODE,0)),U,9) I VALUE'="G" Q
 .. S RESULT=53.79_U_ITEM_U_DATE_"^^"
 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 Q
 ;
DX(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N DATE,DATE2,NODE,NUM,RESULT,VALUE K VALUE
 K ^TMP("ORWGRPC TEMP",$J)
 S DATE2="",CNT=$G(CNT)
 S NUM=""
 F  S NUM=$O(^PXRMINDX(45,"ICD9","PNI",DFN,NUM)) Q:NUM=""  D
 . S DATE=""
 . F  S DATE=$O(^PXRMINDX(45,"ICD9","PNI",DFN,NUM,ITEM,DATE)) Q:DATE=""  D
 .. I DATE>START Q
 .. S NODE=""
 .. F  S NODE=$O(^PXRMINDX(45,"ICD9","PNI",DFN,NUM,ITEM,DATE,NODE)) Q:NODE=""  D
 ... I '$D(^TMP("ORWGRPC TEMP",$J,ITEM,DATE)) S ^TMP("ORWGRPC TEMP",$J,ITEM,DATE)=NODE_U_NUM
 S ITEM=""
 F  S ITEM=$O(^TMP("ORWGRPC TEMP",$J,ITEM)) Q:ITEM=""  D
 . S DATE=""
 . F  S DATE=$O(^TMP("ORWGRPC TEMP",$J,ITEM,DATE)) Q:DATE=""  D
 .. S NODE=$G(^TMP("ORWGRPC TEMP",$J,ITEM,DATE)) I '$L(NODE) Q
 .. S NUM=$P(NODE,U,2)
 .. S NODE=$P(NODE,U)
 .. D PTF^ORWGAPIA(NODE,.VALUE) S VALUE=$$EXT^ORWGAPIX($G(VALUE("DISCHARGE STATUS")),45,6)
 .. I NUM="DXLS" S VALUE="(DXLS)  "_VALUE
 .. S RESULT=45_"DX"_U_ITEM_U_DATE_U_DATE2_U_"  "_VALUE
 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 K ^TMP("ORWGRPC TEMP",$J)
 Q
 ;
INRX(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
 S DATE="",CNT=$G(CNT)
 F  S DATE=$O(^PXRMINDX(55,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
 . I DATE>START Q
 . S DATE2=""
 . F  S DATE2=$O(^PXRMINDX(55,"PI",DFN,ITEM,DATE,DATE2)) Q:DATE2=""  D
 .. S NODE=""
 .. F  S NODE=$O(^PXRMINDX(55,"PI",DFN,ITEM,DATE,DATE2,NODE)) Q:NODE=""  D
 ... D RXIN^ORWGAPIA(NODE,.VALUE) S VALUE=VALUE("STAT")
 ... S VALUE=VALUE_"  "_$$INSIG^ORWGAPIA(NODE)
 ... S RESULT=55_U_ITEM_U_DATE_U_DATE2_U_VALUE
 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 Q
 ;
LAB(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N COMMENT,DATE,DATE2,NODE,RESULT,TYPE,VALUE K VALUE
 S DATE="",DATE2="",CNT=$G(CNT)
 D
 . I $E(ITEM)="A" S TYPE="AP" Q
 . I $E(ITEM)="M" S TYPE="MI" Q
 . S TYPE="" Q
 F  S DATE=$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
 . I DATE>START Q
 . S NODE=""
 . F  S NODE=$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
 .. K VALUE
 .. D LAB^ORWGAPIA(.VALUE,NODE,ITEM)
 .. I TYPE="AP" S RESULT="63AP^"_ITEM_U_DATE_U_DATE2 ;_U_$P(VALUE,U,2)
 .. I TYPE="MI" S RESULT="63MI^"_ITEM_U_DATE_U_DATE2_U_$P(VALUE,U,4)
 .. I TYPE="" D
 ... S COMMENT=""
 ... I $L($G(VALUE("COMMENTS",1))) S COMMENT=1
 ... S RESULT="63^"_ITEM_U_DATE_U_DATE2_U_$P(VALUE,U,3)_U_$P(VALUE,U,4)_U_$G(VALUE("SPECIMEN"))_U_COMMENT
 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 Q
 ;
MED(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 D MED3^ORWGAPID(.DATA,ITEM,START,DFN,.CNT,.TMP)
 Q
 ;
NOTE(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N DATE,DOC,DOCCLASS,DOCTYPE,DUM,IEN,RESULT,RESULTS,TITLE,VALUE K DUM
 K ^TMP("ORWGRPC TEMP",$J),^TMP("TIUR",$J)
 S CNT=$G(CNT),ITEM=$$UP^ORWGAPIX(ITEM)
 F DOCTYPE="P","D","C" D
 . S DOCCLASS=$$DOCCLASS^ORWGAPIA(DOCTYPE)
 . K ^TMP("TIUR",$J)
 . D TIU^ORWGAPIA(.DUM,DOCCLASS,5,DFN)
 . S DOC=0
 . F  S DOC=$O(^TMP("TIUR",$J,DOC)) Q:DOC<1  D
 .. S RESULTS=^TMP("TIUR",$J,DOC)
 .. S IEN=+$P(RESULTS,U)
 .. S TITLE=$$UP^ORWGAPIX($P(RESULTS,U,2))
 .. I TITLE'=ITEM Q
 .. ; do not use admission date S DATE=$P($G(^AUPNVSIT(+$P($G(^TIU(8925,IEN,0)),U,3),0)),U)
 .. S DATE=$P(RESULTS,U,3)
 .. I DATE>START Q
 .. S VALUE=$P(RESULTS,U,7)
 .. S CNT=CNT+1
 .. S RESULT=8925_U_TITLE_U_DATE_"^^"_VALUE
 .. I $D(^TMP("ORWGRPC TEMP",$J,RESULT)) Q
 .. S ^TMP("ORWGRPC TEMP",$J,RESULT)=""
 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 K ^TMP("ORWGRPC TEMP",$J),^TMP("TIUR",$J)
 Q
 ;
NVAE(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
 S DATE="",CNT=$G(CNT)
 F  S DATE=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE)) Q:DATE=""  D
 . I DATE>START Q
 . S DATE2=""
 . F  S DATE2=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE,DATE2)) Q:DATE2=""  D
 .. S NODE=""
 .. F  S NODE=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE,DATE2,NODE)) Q:NODE=""  D
 ... D RXNVA^ORWGAPIA(NODE,.VALUE) S VALUE=$G(VALUE("STATUS"))
 ... S VALUE=VALUE_"  "_$$NVASIG^ORWGAPIA(NODE)
 ... S RESULT="55NVAE"_U_ITEM_U_DATE_"^^"_VALUE ; DATE2 is not used, NVA defined as an event
 ... ;S RESULT="55NVAE"_U_ITEM_U_DATE_U_$S(DATE2["U":DT,1:DATE2)_U_VALUE ; DATE2 is not used, NVA defined as an event
 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 Q
 ;
NVA(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 D NVA3^ORWGAPID(.DATA,ITEM,START,DFN,.CNT,.TMP)
 Q
 ;
ORDER(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N DATE,DATE2,NODE,ORUPCHUK,RESULT,VALUE K ORUPCHUK
 S DATE="",CNT=$G(CNT)
 F  S DATE=$O(^PXRMINDX(100,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
 . I DATE>START Q
 . S DATE2=""
 . F  S DATE2=$O(^PXRMINDX(100,"PI",DFN,ITEM,DATE,DATE2)) Q:DATE2=""  D
 .. S NODE=""
 .. F  S NODE=$O(^PXRMINDX(100,"PI",DFN,ITEM,DATE,DATE2,NODE)) Q:NODE=""  D
 ... D EN^ORX8($P(NODE,";")) S VALUE=$P($G(ORUPCHUK("ORSTS")),U,2)
 ... S RESULT=100_U_ITEM_U_DATE_"^^"_VALUE
 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 Q
 ;
OUTRX(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N DATE1,DATE2,LNUM,NODE,RESULT,VALUE K VALUE
 S DATE1="",DATE2="",CNT=$G(CNT)
 F  S DATE1=$O(^PXRMINDX(52,"PI",DFN,ITEM,DATE1)) Q:DATE1=""  D
 . I DATE1>START Q
 . S DATE2=""
 . F  S DATE2=$O(^PXRMINDX(52,"PI",DFN,ITEM,DATE1,DATE2)) Q:DATE2=""  D
 .. S NODE=""
 .. F  S NODE=$O(^PXRMINDX(52,"PI",DFN,ITEM,DATE1,DATE2,NODE)) Q:NODE=""  D
 ... D RXOUT^ORWGAPIA(NODE,.VALUE) S VALUE=$$EXTERNAL^ORWGAPIX(52,100,"",VALUE("STATUS"))
 ... S VALUE=VALUE_"  "_$$SIG^ORWGAPIA(DFN,+NODE)
 ... S RESULT=52_U_ITEM_U_DATE1_U_DATE2_U_VALUE
 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 Q
 ;
RAD(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
 S DATE="",DATE2="",CNT=$G(CNT)
 F  S DATE=$O(^PXRMINDX(70,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
 . I DATE>START Q
 . S NODE=""
 . F  S NODE=$O(^PXRMINDX(70,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
 .. D RAD^ORWGAPIA(NODE,.VALUE) S VALUE=$G(VALUE("PDX"))_"-"_$G(VALUE("EXAM STATUS"))
 .. S RESULT=70_U_ITEM_U_DATE_U_DATE2_U_VALUE
 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 Q
 ;