Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORWGAPI3

ORWGAPI3.m

Go to the documentation of this file.
  1. ORWGAPI3 ; SLC/STAFF - Graph Data ;07/28/09 11:34
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243,280**;Dec 17, 1997;Build 85
  1. ;
  1. ;
  1. ADVERSE(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
  1. N ADVERSE,DATE,DATE2,NODE,RESULT,RXN,VALUE
  1. S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
  1. S ADVERSE=""
  1. S VALUE=ITEM_U_ITEM
  1. S NODE=""
  1. F S NODE=$O(^GMR(120.8,"B",DFN,NODE)) Q:NODE="" D
  1. . I '$D(^GMR(120.8,NODE,0)) Q
  1. . I $G(^GMR(120.8,NODE,"ER")) Q ; entered in error
  1. . I '$P(^GMR(120.8,NODE,0),U,12) Q ; signed
  1. . S DATE=+$P($G(^GMR(120.8,NODE,0)),U,4) I 'DATE Q
  1. . I DATE>START Q
  1. . I DATE<BACKTO Q
  1. . I ITEM'=$P(^GMR(120.8,NODE,0),U,2) Q
  1. . S RXN=0
  1. . F S RXN=$O(^GMR(120.8,NODE,10,"B",RXN)) Q:RXN<1 D
  1. .. S ADVERSE=ADVERSE_$$EVALUE^ORWGAPIU(RXN,120.8)_", "
  1. . I $L(ADVERSE)>0 S ADVERSE=$E(ADVERSE,1,$L(ADVERSE)-2)
  1. . S CNT=CNT+1
  1. . S RESULT=120.8_U_ITEM_U_DATE_U_DATE2_U_ADVERSE
  1. . D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
  1. Q
  1. ;
  1. DX(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
  1. N DATE,DATE2,NODE,NUM,RESULT,VALUE,VALUES K VALUE
  1. K ^TMP("ORWGRPC TEMP",$J)
  1. S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
  1. S NUM=""
  1. F S NUM=$O(^PXRMINDX(45,"ICD9","PNI",DFN,NUM)) Q:NUM="" D
  1. . S DATE=""
  1. . F S DATE=$O(^PXRMINDX(45,"ICD9","PNI",DFN,NUM,ITEM,DATE)) Q:DATE="" D
  1. .. I DATE>START Q
  1. .. I DATE<BACKTO Q
  1. .. S NODE=""
  1. .. F S NODE=$O(^PXRMINDX(45,"ICD9","PNI",DFN,NUM,ITEM,DATE,NODE)) Q:NODE="" D
  1. ... I '$D(^TMP("ORWGRPC TEMP",$J,ITEM,DATE)) S ^TMP("ORWGRPC TEMP",$J,ITEM,DATE)=NODE_U_NUM
  1. S ITEM=""
  1. F S ITEM=$O(^TMP("ORWGRPC TEMP",$J,ITEM)) Q:ITEM="" D
  1. . S DATE=""
  1. . F S DATE=$O(^TMP("ORWGRPC TEMP",$J,ITEM,DATE)) Q:DATE="" D
  1. .. S NODE=$G(^TMP("ORWGRPC TEMP",$J,ITEM,DATE)) I '$L(NODE) Q
  1. .. S NUM=$P(NODE,U,2)
  1. .. S NODE=$P(NODE,U)
  1. .. I '$L($G(^DGPT(+NODE,0))) Q ; ****** remove this when PTF patch is released **********
  1. .. D PTF^ORWGAPIA(NODE,.VALUE,.VALUES) S VALUE=$$EXT^ORWGAPIX($G(VALUE("DISCHARGE STATUS")),45,6)
  1. .. I NUM="DXLS" S VALUE="(DXLS) "_VALUE_U_U_VALUES ;*****************************
  1. .. S RESULT=45_"DX"_U_ITEM_U_DATE_U_DATE2_U_" "_VALUE
  1. .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
  1. K ^TMP("ORWGRPC TEMP",$J)
  1. Q
  1. ;
  1. LAB(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
  1. N COMMENT,DATE,DATE2,NODE,RESULT,TYPE,VALUE K VALUE
  1. S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
  1. D
  1. . I $E(ITEM)="A" S TYPE="AP" Q
  1. . I $E(ITEM)="M" S TYPE="MI" Q
  1. . S TYPE="" Q
  1. F S DATE=$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE)) Q:DATE="" D
  1. . I DATE>START Q
  1. . I DATE<BACKTO Q
  1. . S NODE=""
  1. . F S NODE=$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
  1. .. K VALUE
  1. .. D LAB^ORWGAPIC(.VALUE,NODE,ITEM)
  1. .. I TYPE="AP" S RESULT="63AP^"_ITEM_U_DATE_U_DATE2 ;_U_$P(VALUE,U,2)
  1. .. I TYPE="MI" S RESULT="63MI^"_ITEM_U_DATE_U_DATE2_U_$P(VALUE,U,4)
  1. .. I TYPE="" D
  1. ... S COMMENT=""
  1. ... I $L($G(VALUE("COMMENTS",1))) S COMMENT=1
  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
  1. ... I $L($P(VALUE,U,7)) S $P(RESULT,U,10)=$P($P(VALUE,U,7),"!",2,3)_U_$P($P(VALUE,U,7),"!",7)
  1. .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
  1. Q
  1. ;
  1. MED(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
  1. D MED3^ORWGAPIE(.DATA,ITEM,START,DFN,.CNT,.TMP)
  1. Q
  1. ;
  1. NOTE(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
  1. N DATE,DOC,DOCCLASS,DOCTYPE,DUM,IEN,RESULT,RESULTS,TITLE,VALUE K DUM
  1. K ^TMP("ORWGRPC TEMP",$J),^TMP("TIUR",$J)
  1. S CNT=$G(CNT),ITEM=$$UP^ORWGAPIX(ITEM),BACKTO=+$G(BACKTO)
  1. F DOCTYPE="P","D","C" D
  1. . S DOCCLASS=$$DOCCLASS^ORWGAPIA(DOCTYPE)
  1. . K ^TMP("TIUR",$J)
  1. . D TIU^ORWGAPIA(.DUM,DOCCLASS,5,DFN)
  1. . S DOC=0
  1. . F S DOC=$O(^TMP("TIUR",$J,DOC)) Q:DOC<1 D
  1. .. S RESULTS=^TMP("TIUR",$J,DOC)
  1. .. S IEN=+$P(RESULTS,U)
  1. .. S TITLE=$$UP^ORWGAPIX($P(RESULTS,U,2))
  1. .. I TITLE'=ITEM Q
  1. .. ; do not use admission date S DATE=$P($G(^AUPNVSIT(+$P($G(^TIU(8925,IEN,0)),U,3),0)),U)
  1. .. S DATE=$P(RESULTS,U,3)
  1. .. I DATE>START Q
  1. .. I DATE<BACKTO Q
  1. .. S VALUE=$P(RESULTS,U,7)
  1. .. S CNT=CNT+1
  1. .. S RESULT=8925_U_TITLE_U_DATE_"^^"_VALUE
  1. .. I $D(^TMP("ORWGRPC TEMP",$J,RESULT)) Q
  1. .. S ^TMP("ORWGRPC TEMP",$J,RESULT)=""
  1. .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
  1. K ^TMP("ORWGRPC TEMP",$J),^TMP("TIUR",$J)
  1. Q
  1. ;
  1. ORDER(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
  1. N DATE,DATE2,NODE,ORUPCHUK,RESULT,VALUE K ORUPCHUK
  1. S DATE="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
  1. F S DATE=$O(^PXRMINDX(100,"PI",DFN,ITEM,DATE)) Q:DATE="" D
  1. . I DATE>START Q
  1. . I DATE<BACKTO Q
  1. . S DATE2=""
  1. . F S DATE2=$O(^PXRMINDX(100,"PI",DFN,ITEM,DATE,DATE2)) Q:DATE2="" D
  1. .. S NODE=""
  1. .. F S NODE=$O(^PXRMINDX(100,"PI",DFN,ITEM,DATE,DATE2,NODE)) Q:NODE="" D
  1. ... D EN^ORX8($P(NODE,";")) S VALUE=$P($G(ORUPCHUK("ORSTS")),U,2)
  1. ... S RESULT=100_U_ITEM_U_DATE_"^^"_VALUE
  1. ... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
  1. Q
  1. ;
  1. RAD(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
  1. N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
  1. S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
  1. F S DATE=$O(^PXRMINDX(70,"PI",DFN,ITEM,DATE)) Q:DATE="" D
  1. . I DATE>START Q
  1. . I DATE<BACKTO Q
  1. . S NODE=""
  1. . F S NODE=$O(^PXRMINDX(70,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
  1. .. D RAD^ORWGAPIA(NODE,.VALUE,.VALUES) S VALUE=$G(VALUE("PDX"))_"-"_$G(VALUE("EXAM STATUS"))_U_U_VALUES
  1. .. S RESULT=70_U_ITEM_U_DATE_U_DATE2_U_VALUE
  1. .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
  1. Q
  1. ;