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

ORWGAPI4.m

Go to the documentation of this file.
  1. ORWGAPI4 ; SLC/STAFF - Graph Data, indexed ;8/21/06 07:52
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,260,243**;Dec 17, 1997;Build 242
  1. ;
  1. EDU(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(9000010.16,"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(9000010.16,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
  1. .. D EDU^ORWGAPIA(NODE,.VALUE,.VALUES)
  1. .. S VALUE=VALUE("VALUE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.16,.06)_U_VALUES ;*****************************
  1. .. S RESULT=9000010.16_U_ITEM_U_DATE_"^^" ;_VALUE
  1. .. S RESULT=9000010.16_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
  1. .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
  1. Q
  1. ;
  1. EXAM(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(9000010.13,"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(9000010.13,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
  1. .. D EXAM^ORWGAPIA(NODE,.VALUE,.VALUES)
  1. .. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.13,.04)_U_VALUES ;*****************************
  1. .. S RESULT=9000010.13_U_ITEM_U_DATE_U_DATE2_U_VALUE
  1. .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
  1. Q
  1. ;
  1. HF(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(9000010.23,"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(9000010.23,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
  1. .. D HF^ORWGAPIA(NODE,.VALUE,.VALUES)
  1. .. S VALUE=VALUE("VALUE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.23,.04)_U_VALUES ;*****************************
  1. .. S RESULT=9000010.23_U_ITEM_U_DATE_U_DATE2_U_VALUE
  1. .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
  1. Q
  1. ;
  1. IMM(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(9000010.11,"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(9000010.11,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
  1. .. D IMM^ORWGAPIA(NODE,.VALUE,.VALUES)
  1. .. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.11,.04)_U_VALUES ;*****************************
  1. .. S CNT=CNT+1
  1. .. S RESULT=9000010.11_U_ITEM_U_DATE_U_DATE2_U_VALUE
  1. .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
  1. Q
  1. ;
  1. MH(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(601.2,"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(601.2,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
  1. .. D MH^ORWGAPIA(.VALUE,NODE,.VALUES) S VALUE=$P($G(VALUE(2)),U,2,3)_U_VALUES ;*****************************
  1. .. S RESULT=601.2_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
  1. .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
  1. Q
  1. ;
  1. OP(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
  1. N DATE,DATE2,NODE,NUM,RESULT,VALUE,VALUES K VALUE
  1. S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO),VALUES=""
  1. S NUM=""
  1. F S NUM=$O(^PXRMINDX(45,"ICD0","PNI",DFN,NUM)) Q:NUM="" D
  1. . S DATE=""
  1. . F S DATE=$O(^PXRMINDX(45,"ICD0","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,"ICD0","PNI",DFN,NUM,ITEM,DATE,NODE)) Q:NODE="" D
  1. ... I '$L($G(^DGPT(+NODE,0))) Q ; ****** remove this when PTF patch is released **********
  1. ... D PTF^ORWGAPIA(NODE,.VALUE,.VALUES) S VALUE=$G(VALUE("DISCHARGE STATUS"))_U_VALUES ;*****************************
  1. ... S RESULT=45_"OP"_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
  1. ... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
  1. Q
  1. ;
  1. POV(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
  1. N DATE,DATE2,NODE,RESULT,TYPE,VALUE,VALUES K VALUE
  1. S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
  1. S TYPE=""
  1. F S TYPE=$O(^PXRMINDX(9000010.07,"PPI",DFN,TYPE)) Q:TYPE="" D
  1. . S DATE=""
  1. . F S DATE=$O(^PXRMINDX(9000010.07,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE="" D
  1. .. I DATE>START Q
  1. .. I DATE<BACKTO Q
  1. .. S NODE=""
  1. .. F S NODE=$O(^PXRMINDX(9000010.07,"PPI",DFN,TYPE,ITEM,DATE,NODE)) Q:NODE="" D
  1. ... D POV^ORWGAPIA(NODE,.VALUE,.VALUES)
  1. ... S VALUE=VALUE("CLINICAL TERM"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.07,.15)_U_VALUES ;*****************************
  1. ... S CNT=CNT+1
  1. ... S RESULT=9000010.07_U_ITEM_U_DATE_U_DATE2_U_VALUE
  1. ... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
  1. Q
  1. ;
  1. PROB(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
  1. N DATE,DATE2,DTONSET,DTRESOLV,ICD9,NODE,PRIORITY,PROB,PROBDX,PSTATUS,RESULT,STATUS,VALUE
  1. K ^TMP("ORWGRPC TEMP",$J)
  1. S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
  1. S STATUS=""
  1. F S STATUS=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS)) Q:STATUS="" D
  1. . S PRIORITY=""
  1. . F S PRIORITY=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY="" D
  1. .. S DATE=""
  1. .. F S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE)) Q:DATE="" D
  1. ... I DATE>START Q
  1. ... I DATE<BACKTO Q
  1. ... S NODE=""
  1. ... F S NODE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,NODE)) Q:NODE="" D
  1. .... S ^TMP("ORWGRPC TEMP",$J,ITEM,DATE,NODE)=""
  1. S ICD9=""
  1. F S ICD9=$O(^TMP("ORWGRPC TEMP",$J,ICD9)) Q:ICD9="" D
  1. . S DATE=""
  1. . F S DATE=$O(^TMP("ORWGRPC TEMP",$J,ICD9,DATE)) Q:DATE="" D
  1. .. S NODE=""
  1. .. F S NODE=$O(^TMP("ORWGRPC TEMP",$J,ICD9,DATE,NODE)) Q:NODE="" D
  1. ... D PROB^ORWGAPIA(.PROB,.PSTATUS,.PROBDX,.DTONSET,.DTRESOLV,NODE)
  1. ... S RESULT=9000011_U_ITEM_U_DTONSET_U_DATE2_U_$$EXT^ORWGAPIX(PSTATUS,9000011,.12)
  1. ... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
  1. K ^TMP("ORWGRPC TEMP",$J)
  1. Q
  1. ;
  1. PROBX(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
  1. D PROBX4^ORWGAPID(.DATA,ITEM,START,DFN,.CNT,.TMP)
  1. Q
  1. ;
  1. PROC(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
  1. N DATE,DATE2,NODE,RESULT,TYPE,VALUE,VALUES K VALUE
  1. S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
  1. S TYPE=""
  1. F S TYPE=$O(^PXRMINDX(9000010.18,"PPI",DFN,TYPE)) Q:TYPE="" D
  1. . S DATE=""
  1. . F S DATE=$O(^PXRMINDX(9000010.18,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE="" D
  1. .. I DATE>START Q
  1. .. I DATE<BACKTO Q
  1. .. S NODE=""
  1. .. F S NODE=$O(^PXRMINDX(9000010.18,"PPI",DFN,TYPE,ITEM,DATE,NODE)) Q:NODE="" D
  1. ... D CPT^ORWGAPIA(NODE,.VALUE,.VALUES)
  1. ... S VALUE=VALUE("PRINCIPAL PROCEDURE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.18,.07)_U_VALUES ;*****************************
  1. ... S RESULT=9000010.18_U_ITEM_U_DATE_U_DATE2_U_VALUE
  1. ... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
  1. Q
  1. ;
  1. SKIN(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(9000010.12,"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(9000010.12,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
  1. .. D SKIN^ORWGAPIA(NODE,.VALUE,.VALUES)
  1. .. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.12,.04)_U_VALUES ;*****************************
  1. .. S CNT=CNT+1
  1. .. S RESULT=9000010.12_U_ITEM_U_DATE_U_DATE2_U_VALUE
  1. .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
  1. Q
  1. ;
  1. VITAL(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
  1. I ITEM=99999 D BMIDATA^ORWGAPIX(.DATA,ITEM,START,DFN,.CNT,TMP) Q
  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(120.5,"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(120.5,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
  1. .. D VITAL^ORWGAPIA(.VALUE,NODE,.VALUES) S VALUE=$P($G(VALUE(7)),U)
  1. .. I $P($G(VALUE(3)),U,2)="PAIN",VALUE=99 S VALUE="(99)"
  1. .. S RESULT=120.5_U_ITEM_U_DATE_U_DATE2_U_VALUE_U_U_VALUES ;*****************************
  1. .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
  1. Q
  1. ;