ORWGAPI4 ; SLC/STAFF - Graph Data, indexed ;31-Dec-2012 10:33;PLS
;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,260,243,1010**;Dec 17, 1997;Build 47
;
;Modified - IHS/MSC/MGH - 02/08/2012 - New MEAS EP
; - 07/17/2012 - Changes made to HF and PROB sections for dates
EDU(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
F S DATE=$O(^PXRMINDX(9000010.16,"PI",DFN,ITEM,DATE)) Q:DATE="" D
. I DATE>START Q
. I DATE<BACKTO Q
. S NODE=""
. F S NODE=$O(^PXRMINDX(9000010.16,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
.. D EDU^ORWGAPIA(NODE,.VALUE,.VALUES)
.. S VALUE=VALUE("VALUE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.16,.06)_U_VALUES ;*****************************
.. S RESULT=9000010.16_U_ITEM_U_DATE_"^^" ;_VALUE
.. S RESULT=9000010.16_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
.. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
Q
;
EXAM(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
F S DATE=$O(^PXRMINDX(9000010.13,"PI",DFN,ITEM,DATE)) Q:DATE="" D
. I DATE>START Q
. I DATE<BACKTO Q
. S NODE=""
. F S NODE=$O(^PXRMINDX(9000010.13,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
.. D EXAM^ORWGAPIA(NODE,.VALUE,.VALUES)
.. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.13,.04)_U_VALUES ;*****************************
.. S RESULT=9000010.13_U_ITEM_U_DATE_U_DATE2_U_VALUE
.. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
Q
;
HF(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
F S DATE=$O(^PXRMINDX(9000010.23,"PI",DFN,ITEM,DATE)) Q:DATE="" D
. I DATE>START Q
. I DATE<BACKTO Q
. S NODE=""
. F S NODE=$O(^PXRMINDX(9000010.23,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
.. D HF^ORWGAPIA(NODE,.VALUE,.VALUES)
.. S VALUE=VALUE("VALUE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.23,.04)_U_VALUES ;*****************************
.. S RESULT=9000010.23_U_ITEM_U_DATE_U_DATE_U_VALUE
.. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
Q
;
IMM(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
F S DATE=$O(^PXRMINDX(9000010.11,"PI",DFN,ITEM,DATE)) Q:DATE="" D
. I DATE>START Q
. I DATE<BACKTO Q
. S NODE=""
. F S NODE=$O(^PXRMINDX(9000010.11,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
.. D IMM^ORWGAPIA(NODE,.VALUE,.VALUES)
.. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.11,.04)_U_VALUES ;*****************************
.. S CNT=CNT+1
.. S RESULT=9000010.11_U_ITEM_U_DATE_U_DATE2_U_VALUE
.. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
Q
;
MH(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
F S DATE=$O(^PXRMINDX(601.2,"PI",DFN,ITEM,DATE)) Q:DATE="" D
. I DATE>START Q
. I DATE<BACKTO Q
. S NODE=""
. F S NODE=$O(^PXRMINDX(601.2,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
.. D MH^ORWGAPIA(.VALUE,NODE,.VALUES) S VALUE=$P($G(VALUE(2)),U,2,3)_U_VALUES ;*****************************
.. S RESULT=601.2_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
.. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
Q
;
OP(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
N DATE,DATE2,NODE,NUM,RESULT,VALUE,VALUES K VALUE
S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO),VALUES=""
S NUM=""
F S NUM=$O(^PXRMINDX(45,"ICD0","PNI",DFN,NUM)) Q:NUM="" D
. S DATE=""
. F S DATE=$O(^PXRMINDX(45,"ICD0","PNI",DFN,NUM,ITEM,DATE)) Q:DATE="" D
.. I DATE>START Q
.. I DATE<BACKTO Q
.. S NODE=""
.. F S NODE=$O(^PXRMINDX(45,"ICD0","PNI",DFN,NUM,ITEM,DATE,NODE)) Q:NODE="" D
... I '$L($G(^DGPT(+NODE,0))) Q ; ****** remove this when PTF patch is released **********
... D PTF^ORWGAPIA(NODE,.VALUE,.VALUES) S VALUE=$G(VALUE("DISCHARGE STATUS"))_U_VALUES ;*****************************
... S RESULT=45_"OP"_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
Q
;
POV(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
N DATE,DATE2,NODE,RESULT,TYPE,VALUE,VALUES K VALUE
S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
S TYPE=""
F S TYPE=$O(^PXRMINDX(9000010.07,"PPI",DFN,TYPE)) Q:TYPE="" D
. S DATE=""
. F S DATE=$O(^PXRMINDX(9000010.07,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE="" D
.. I DATE>START Q
.. I DATE<BACKTO Q
.. S NODE=""
.. F S NODE=$O(^PXRMINDX(9000010.07,"PPI",DFN,TYPE,ITEM,DATE,NODE)) Q:NODE="" D
... D POV^ORWGAPIA(NODE,.VALUE,.VALUES)
... S VALUE=VALUE("CLINICAL TERM"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.07,.15)_U_VALUES ;*****************************
... S CNT=CNT+1
... S RESULT=9000010.07_U_ITEM_U_DATE_U_DATE2_U_VALUE
... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
Q
;
PROB(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
N DATE,DATE2,DTONSET,DTRESOLV,ICD9,NODE,PRIORITY,PROB,PROBDX,PSTATUS,RESULT,STATUS,VALUE
K ^TMP("ORWGRPC TEMP",$J)
S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
S STATUS=""
F S STATUS=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS)) Q:STATUS="" D
. S PRIORITY=""
. F S PRIORITY=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY="" D
.. S DATE=""
.. F S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE)) Q:DATE="" D
... I DATE>START Q
... I DATE<BACKTO Q
... S NODE=""
... F S NODE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,NODE)) Q:NODE="" D
.... S ^TMP("ORWGRPC TEMP",$J,ITEM,DATE,NODE)=""
S ICD9=""
F S ICD9=$O(^TMP("ORWGRPC TEMP",$J,ICD9)) Q:ICD9="" D
. S DATE=""
. F S DATE=$O(^TMP("ORWGRPC TEMP",$J,ICD9,DATE)) Q:DATE="" D
.. S NODE=""
.. F S NODE=$O(^TMP("ORWGRPC TEMP",$J,ICD9,DATE,NODE)) Q:NODE="" D
... D PROB^ORWGAPIA(.PROB,.PSTATUS,.PROBDX,.DTONSET,.DTRESOLV,NODE)
... S RESULT=9000011_U_ITEM_U_DATE_U_DATE2_U_$$EXT^ORWGAPIX(PSTATUS,9000011,.12)
... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
K ^TMP("ORWGRPC TEMP",$J)
Q
;
PROBX(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
D PROBX4^ORWGAPID(.DATA,ITEM,START,DFN,.CNT,.TMP)
Q
;
PROC(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
N DATE,DATE2,NODE,RESULT,TYPE,VALUE,VALUES K VALUE
S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
S TYPE=""
F S TYPE=$O(^PXRMINDX(9000010.18,"PPI",DFN,TYPE)) Q:TYPE="" D
. S DATE=""
. F S DATE=$O(^PXRMINDX(9000010.18,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE="" D
.. I DATE>START Q
.. I DATE<BACKTO Q
.. S NODE=""
.. F S NODE=$O(^PXRMINDX(9000010.18,"PPI",DFN,TYPE,ITEM,DATE,NODE)) Q:NODE="" D
... D CPT^ORWGAPIA(NODE,.VALUE,.VALUES)
... S VALUE=VALUE("PRINCIPAL PROCEDURE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.18,.07)_U_VALUES ;*****************************
... S RESULT=9000010.18_U_ITEM_U_DATE_U_DATE2_U_VALUE
... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
Q
;
SKIN(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
F S DATE=$O(^PXRMINDX(9000010.12,"PI",DFN,ITEM,DATE)) Q:DATE="" D
. I DATE>START Q
. I DATE<BACKTO Q
. S NODE=""
. F S NODE=$O(^PXRMINDX(9000010.12,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
.. D SKIN^ORWGAPIA(NODE,.VALUE,.VALUES)
.. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.12,.04)_U_VALUES ;*****************************
.. S CNT=CNT+1
.. S RESULT=9000010.12_U_ITEM_U_DATE_U_DATE2_U_VALUE
.. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
Q
;
VITAL(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
I ITEM=99999 D BMIDATA^ORWGAPIX(.DATA,ITEM,START,DFN,.CNT,TMP) Q
N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
F S DATE=$O(^PXRMINDX(120.5,"PI",DFN,ITEM,DATE)) Q:DATE="" D
. I DATE>START Q
. I DATE<BACKTO Q
. S NODE=""
. F S NODE=$O(^PXRMINDX(120.5,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
.. D VITAL^ORWGAPIA(.VALUE,NODE,.VALUES) S VALUE=$P($G(VALUE(7)),U)
.. I $P($G(VALUE(3)),U,2)="PAIN",VALUE=99 S VALUE="(99)"
.. S RESULT=120.5_U_ITEM_U_DATE_U_DATE2_U_VALUE_U_U_VALUES ;*****************************
.. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
Q
;
;IHS/MSC/MGH Added entry for graphing measurements
MEAS(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ;EP-
N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
I ITEM=99999 D BMIDATA2^ORWGAPIX(.DATA,ITEM,START,DFN,.CNT,TMP) Q
S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
F S DATE=$O(^PXRMINDX(9000010.01,"PI",DFN,ITEM,DATE)) Q:DATE="" D
. I DATE>START Q
. I DATE<BACKTO Q
. S NODE=""
. F S NODE=$O(^PXRMINDX(9000010.01,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
.. D MEAS^ORWGAPIA(.VALUE,NODE,.VALUES) S VALUE=$P($G(VALUE(7)),U)
.. I $P($G(VALUE(3)),U,2)="PAIN",VALUE=99 S VALUE="(99)"
.. S RESULT=9000010.01_U_ITEM_U_DATE_U_DATE2_U_VALUE_U_U_VALUES ;*****************************
.. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
Q
ORWGAPI4 ; SLC/STAFF - Graph Data, indexed ;31-Dec-2012 10:33;PLS
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,260,243,1010**;Dec 17, 1997;Build 47
+2 ;
+3 ;Modified - IHS/MSC/MGH - 02/08/2012 - New MEAS EP
+4 ; - 07/17/2012 - Changes made to HF and PROB sections for dates
EDU(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
+1 NEW DATE,DATE2,NODE,RESULT,VALUE,VALUES
KILL VALUE
+2 SET DATE=""
SET DATE2=""
SET CNT=$GET(CNT)
SET BACKTO=+$GET(BACKTO)
+3 FOR
SET DATE=$ORDER(^PXRMINDX(9000010.16,"PI",DFN,ITEM,DATE))
IF DATE=""
QUIT
Begin DoDot:1
+4 IF DATE>START
QUIT
+5 IF DATE<BACKTO
QUIT
+6 SET NODE=""
+7 FOR
SET NODE=$ORDER(^PXRMINDX(9000010.16,"PI",DFN,ITEM,DATE,NODE))
IF NODE=""
QUIT
Begin DoDot:2
+8 DO EDU^ORWGAPIA(NODE,.VALUE,.VALUES)
+9 ;*****************************
SET VALUE=VALUE("VALUE")
SET VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.16,.06)_U_VALUES
+10 ;_VALUE
SET RESULT=9000010.16_U_ITEM_U_DATE_"^^"
+11 ;_VALUE
SET RESULT=9000010.16_U_ITEM_U_DATE_U_DATE2_U
+12 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
EXAM(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
+1 NEW DATE,DATE2,NODE,RESULT,VALUE,VALUES
KILL VALUE
+2 SET DATE=""
SET DATE2=""
SET CNT=$GET(CNT)
SET BACKTO=+$GET(BACKTO)
+3 FOR
SET DATE=$ORDER(^PXRMINDX(9000010.13,"PI",DFN,ITEM,DATE))
IF DATE=""
QUIT
Begin DoDot:1
+4 IF DATE>START
QUIT
+5 IF DATE<BACKTO
QUIT
+6 SET NODE=""
+7 FOR
SET NODE=$ORDER(^PXRMINDX(9000010.13,"PI",DFN,ITEM,DATE,NODE))
IF NODE=""
QUIT
Begin DoDot:2
+8 DO EXAM^ORWGAPIA(NODE,.VALUE,.VALUES)
+9 ;*****************************
SET VALUE=$GET(VALUE("VALUE"))
SET VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.13,.04)_U_VALUES
+10 SET RESULT=9000010.13_U_ITEM_U_DATE_U_DATE2_U_VALUE
+11 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
HF(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
+1 NEW DATE,DATE2,NODE,RESULT,VALUE,VALUES
KILL VALUE
+2 SET DATE=""
SET DATE2=""
SET CNT=$GET(CNT)
SET BACKTO=+$GET(BACKTO)
+3 FOR
SET DATE=$ORDER(^PXRMINDX(9000010.23,"PI",DFN,ITEM,DATE))
IF DATE=""
QUIT
Begin DoDot:1
+4 IF DATE>START
QUIT
+5 IF DATE<BACKTO
QUIT
+6 SET NODE=""
+7 FOR
SET NODE=$ORDER(^PXRMINDX(9000010.23,"PI",DFN,ITEM,DATE,NODE))
IF NODE=""
QUIT
Begin DoDot:2
+8 DO HF^ORWGAPIA(NODE,.VALUE,.VALUES)
+9 ;*****************************
SET VALUE=VALUE("VALUE")
SET VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.23,.04)_U_VALUES
+10 SET RESULT=9000010.23_U_ITEM_U_DATE_U_DATE_U_VALUE
+11 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
IMM(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
+1 NEW DATE,DATE2,NODE,RESULT,VALUE,VALUES
KILL VALUE
+2 SET DATE=""
SET DATE2=""
SET CNT=$GET(CNT)
SET BACKTO=+$GET(BACKTO)
+3 FOR
SET DATE=$ORDER(^PXRMINDX(9000010.11,"PI",DFN,ITEM,DATE))
IF DATE=""
QUIT
Begin DoDot:1
+4 IF DATE>START
QUIT
+5 IF DATE<BACKTO
QUIT
+6 SET NODE=""
+7 FOR
SET NODE=$ORDER(^PXRMINDX(9000010.11,"PI",DFN,ITEM,DATE,NODE))
IF NODE=""
QUIT
Begin DoDot:2
+8 DO IMM^ORWGAPIA(NODE,.VALUE,.VALUES)
+9 ;*****************************
SET VALUE=$GET(VALUE("VALUE"))
SET VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.11,.04)_U_VALUES
+10 SET CNT=CNT+1
+11 SET RESULT=9000010.11_U_ITEM_U_DATE_U_DATE2_U_VALUE
+12 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
MH(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
+1 NEW DATE,DATE2,NODE,RESULT,VALUE,VALUES
KILL VALUE
+2 SET DATE=""
SET DATE2=""
SET CNT=$GET(CNT)
SET BACKTO=+$GET(BACKTO)
+3 FOR
SET DATE=$ORDER(^PXRMINDX(601.2,"PI",DFN,ITEM,DATE))
IF DATE=""
QUIT
Begin DoDot:1
+4 IF DATE>START
QUIT
+5 IF DATE<BACKTO
QUIT
+6 SET NODE=""
+7 FOR
SET NODE=$ORDER(^PXRMINDX(601.2,"PI",DFN,ITEM,DATE,NODE))
IF NODE=""
QUIT
Begin DoDot:2
+8 ;*****************************
DO MH^ORWGAPIA(.VALUE,NODE,.VALUES)
SET VALUE=$PIECE($GET(VALUE(2)),U,2,3)_U_VALUES
+9 ;_VALUE
SET RESULT=601.2_U_ITEM_U_DATE_U_DATE2_U
+10 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
OP(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
+1 NEW DATE,DATE2,NODE,NUM,RESULT,VALUE,VALUES
KILL VALUE
+2 SET DATE2=""
SET CNT=$GET(CNT)
SET BACKTO=+$GET(BACKTO)
SET VALUES=""
+3 SET NUM=""
+4 FOR
SET NUM=$ORDER(^PXRMINDX(45,"ICD0","PNI",DFN,NUM))
IF NUM=""
QUIT
Begin DoDot:1
+5 SET DATE=""
+6 FOR
SET DATE=$ORDER(^PXRMINDX(45,"ICD0","PNI",DFN,NUM,ITEM,DATE))
IF DATE=""
QUIT
Begin DoDot:2
+7 IF DATE>START
QUIT
+8 IF DATE<BACKTO
QUIT
+9 SET NODE=""
+10 FOR
SET NODE=$ORDER(^PXRMINDX(45,"ICD0","PNI",DFN,NUM,ITEM,DATE,NODE))
IF NODE=""
QUIT
Begin DoDot:3
+11 ; ****** remove this when PTF patch is released **********
IF '$LENGTH($GET(^DGPT(+NODE,0)))
QUIT
+12 ;*****************************
DO PTF^ORWGAPIA(NODE,.VALUE,.VALUES)
SET VALUE=$GET(VALUE("DISCHARGE STATUS"))_U_VALUES
+13 ;_VALUE
SET RESULT=45_"OP"_U_ITEM_U_DATE_U_DATE2_U
+14 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
POV(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
+1 NEW DATE,DATE2,NODE,RESULT,TYPE,VALUE,VALUES
KILL VALUE
+2 SET DATE2=""
SET CNT=$GET(CNT)
SET BACKTO=+$GET(BACKTO)
+3 SET TYPE=""
+4 FOR
SET TYPE=$ORDER(^PXRMINDX(9000010.07,"PPI",DFN,TYPE))
IF TYPE=""
QUIT
Begin DoDot:1
+5 SET DATE=""
+6 FOR
SET DATE=$ORDER(^PXRMINDX(9000010.07,"PPI",DFN,TYPE,ITEM,DATE))
IF DATE=""
QUIT
Begin DoDot:2
+7 IF DATE>START
QUIT
+8 IF DATE<BACKTO
QUIT
+9 SET NODE=""
+10 FOR
SET NODE=$ORDER(^PXRMINDX(9000010.07,"PPI",DFN,TYPE,ITEM,DATE,NODE))
IF NODE=""
QUIT
Begin DoDot:3
+11 DO POV^ORWGAPIA(NODE,.VALUE,.VALUES)
+12 ;*****************************
SET VALUE=VALUE("CLINICAL TERM")
SET VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.07,.15)_U_VALUES
+13 SET CNT=CNT+1
+14 SET RESULT=9000010.07_U_ITEM_U_DATE_U_DATE2_U_VALUE
+15 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
PROB(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
+1 NEW DATE,DATE2,DTONSET,DTRESOLV,ICD9,NODE,PRIORITY,PROB,PROBDX,PSTATUS,RESULT,STATUS,VALUE
+2 KILL ^TMP("ORWGRPC TEMP",$JOB)
+3 SET DATE2=""
SET CNT=$GET(CNT)
SET BACKTO=+$GET(BACKTO)
+4 SET STATUS=""
+5 FOR
SET STATUS=$ORDER(^PXRMINDX(9000011,"PSPI",DFN,STATUS))
IF STATUS=""
QUIT
Begin DoDot:1
+6 SET PRIORITY=""
+7 FOR
SET PRIORITY=$ORDER(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY))
IF PRIORITY=""
QUIT
Begin DoDot:2
+8 SET DATE=""
+9 FOR
SET DATE=$ORDER(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE))
IF DATE=""
QUIT
Begin DoDot:3
+10 IF DATE>START
QUIT
+11 IF DATE<BACKTO
QUIT
+12 SET NODE=""
+13 FOR
SET NODE=$ORDER(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,NODE))
IF NODE=""
QUIT
Begin DoDot:4
+14 SET ^TMP("ORWGRPC TEMP",$JOB,ITEM,DATE,NODE)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 SET ICD9=""
+16 FOR
SET ICD9=$ORDER(^TMP("ORWGRPC TEMP",$JOB,ICD9))
IF ICD9=""
QUIT
Begin DoDot:1
+17 SET DATE=""
+18 FOR
SET DATE=$ORDER(^TMP("ORWGRPC TEMP",$JOB,ICD9,DATE))
IF DATE=""
QUIT
Begin DoDot:2
+19 SET NODE=""
+20 FOR
SET NODE=$ORDER(^TMP("ORWGRPC TEMP",$JOB,ICD9,DATE,NODE))
IF NODE=""
QUIT
Begin DoDot:3
+21 DO PROB^ORWGAPIA(.PROB,.PSTATUS,.PROBDX,.DTONSET,.DTRESOLV,NODE)
+22 SET RESULT=9000011_U_ITEM_U_DATE_U_DATE2_U_$$EXT^ORWGAPIX(PSTATUS,9000011,.12)
+23 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:3
End DoDot:2
End DoDot:1
+24 KILL ^TMP("ORWGRPC TEMP",$JOB)
+25 QUIT
+26 ;
PROBX(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
+1 DO PROBX4^ORWGAPID(.DATA,ITEM,START,DFN,.CNT,.TMP)
+2 QUIT
+3 ;
PROC(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
+1 NEW DATE,DATE2,NODE,RESULT,TYPE,VALUE,VALUES
KILL VALUE
+2 SET DATE2=""
SET CNT=$GET(CNT)
SET BACKTO=+$GET(BACKTO)
+3 SET TYPE=""
+4 FOR
SET TYPE=$ORDER(^PXRMINDX(9000010.18,"PPI",DFN,TYPE))
IF TYPE=""
QUIT
Begin DoDot:1
+5 SET DATE=""
+6 FOR
SET DATE=$ORDER(^PXRMINDX(9000010.18,"PPI",DFN,TYPE,ITEM,DATE))
IF DATE=""
QUIT
Begin DoDot:2
+7 IF DATE>START
QUIT
+8 IF DATE<BACKTO
QUIT
+9 SET NODE=""
+10 FOR
SET NODE=$ORDER(^PXRMINDX(9000010.18,"PPI",DFN,TYPE,ITEM,DATE,NODE))
IF NODE=""
QUIT
Begin DoDot:3
+11 DO CPT^ORWGAPIA(NODE,.VALUE,.VALUES)
+12 ;*****************************
SET VALUE=VALUE("PRINCIPAL PROCEDURE")
SET VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.18,.07)_U_VALUES
+13 SET RESULT=9000010.18_U_ITEM_U_DATE_U_DATE2_U_VALUE
+14 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
SKIN(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
+1 NEW DATE,DATE2,NODE,RESULT,VALUE,VALUES
KILL VALUE
+2 SET DATE=""
SET DATE2=""
SET CNT=$GET(CNT)
SET BACKTO=+$GET(BACKTO)
+3 FOR
SET DATE=$ORDER(^PXRMINDX(9000010.12,"PI",DFN,ITEM,DATE))
IF DATE=""
QUIT
Begin DoDot:1
+4 IF DATE>START
QUIT
+5 IF DATE<BACKTO
QUIT
+6 SET NODE=""
+7 FOR
SET NODE=$ORDER(^PXRMINDX(9000010.12,"PI",DFN,ITEM,DATE,NODE))
IF NODE=""
QUIT
Begin DoDot:2
+8 DO SKIN^ORWGAPIA(NODE,.VALUE,.VALUES)
+9 ;*****************************
SET VALUE=$GET(VALUE("VALUE"))
SET VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.12,.04)_U_VALUES
+10 SET CNT=CNT+1
+11 SET RESULT=9000010.12_U_ITEM_U_DATE_U_DATE2_U_VALUE
+12 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
VITAL(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
+1 IF ITEM=99999
DO BMIDATA^ORWGAPIX(.DATA,ITEM,START,DFN,.CNT,TMP)
QUIT
+2 NEW DATE,DATE2,NODE,RESULT,VALUE,VALUES
KILL VALUE
+3 SET DATE=""
SET DATE2=""
SET CNT=$GET(CNT)
SET BACKTO=+$GET(BACKTO)
+4 FOR
SET DATE=$ORDER(^PXRMINDX(120.5,"PI",DFN,ITEM,DATE))
IF DATE=""
QUIT
Begin DoDot:1
+5 IF DATE>START
QUIT
+6 IF DATE<BACKTO
QUIT
+7 SET NODE=""
+8 FOR
SET NODE=$ORDER(^PXRMINDX(120.5,"PI",DFN,ITEM,DATE,NODE))
IF NODE=""
QUIT
Begin DoDot:2
+9 DO VITAL^ORWGAPIA(.VALUE,NODE,.VALUES)
SET VALUE=$PIECE($GET(VALUE(7)),U)
+10 IF $PIECE($GET(VALUE(3)),U,2)="PAIN"
IF VALUE=99
SET VALUE="(99)"
+11 ;*****************************
SET RESULT=120.5_U_ITEM_U_DATE_U_DATE2_U_VALUE_U_U_VALUES
+12 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
+15 ;IHS/MSC/MGH Added entry for graphing measurements
MEAS(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ;EP-
+1 NEW DATE,DATE2,NODE,RESULT,VALUE,VALUES
KILL VALUE
+2 IF ITEM=99999
DO BMIDATA2^ORWGAPIX(.DATA,ITEM,START,DFN,.CNT,TMP)
QUIT
+3 SET DATE=""
SET DATE2=""
SET CNT=$GET(CNT)
SET BACKTO=+$GET(BACKTO)
+4 FOR
SET DATE=$ORDER(^PXRMINDX(9000010.01,"PI",DFN,ITEM,DATE))
IF DATE=""
QUIT
Begin DoDot:1
+5 IF DATE>START
QUIT
+6 IF DATE<BACKTO
QUIT
+7 SET NODE=""
+8 FOR
SET NODE=$ORDER(^PXRMINDX(9000010.01,"PI",DFN,ITEM,DATE,NODE))
IF NODE=""
QUIT
Begin DoDot:2
+9 DO MEAS^ORWGAPIA(.VALUE,NODE,.VALUES)
SET VALUE=$PIECE($GET(VALUE(7)),U)
+10 IF $PIECE($GET(VALUE(3)),U,2)="PAIN"
IF VALUE=99
SET VALUE="(99)"
+11 ;*****************************
SET RESULT=9000010.01_U_ITEM_U_DATE_U_DATE2_U_VALUE_U_U_VALUES
+12 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:2
End DoDot:1
+13 QUIT
