ORWGAPI3 ; SLC/STAFF - Graph Data ;07/28/09 11:34
;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243,280**;Dec 17, 1997;Build 85
;
;
ADVERSE(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
N ADVERSE,DATE,DATE2,NODE,RESULT,RXN,VALUE
S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
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 DATE<BACKTO 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^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
Q
;
DX(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
N DATE,DATE2,NODE,NUM,RESULT,VALUE,VALUES K VALUE
K ^TMP("ORWGRPC TEMP",$J)
S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
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
.. I DATE<BACKTO 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)
.. I '$L($G(^DGPT(+NODE,0))) Q ; ****** remove this when PTF patch is released **********
.. D PTF^ORWGAPIA(NODE,.VALUE,.VALUES) S VALUE=$$EXT^ORWGAPIX($G(VALUE("DISCHARGE STATUS")),45,6)
.. I NUM="DXLS" S VALUE="(DXLS) "_VALUE_U_U_VALUES ;*****************************
.. S RESULT=45_"DX"_U_ITEM_U_DATE_U_DATE2_U_" "_VALUE
.. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
K ^TMP("ORWGRPC TEMP",$J)
Q
;
LAB(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
N COMMENT,DATE,DATE2,NODE,RESULT,TYPE,VALUE K VALUE
S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
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
. I DATE<BACKTO Q
. S NODE=""
. F S NODE=$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
.. K VALUE
.. D LAB^ORWGAPIC(.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
... 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)
.. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
Q
;
MED(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
D MED3^ORWGAPIE(.DATA,ITEM,START,DFN,.CNT,.TMP)
Q
;
NOTE(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; 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),BACKTO=+$G(BACKTO)
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
.. I DATE<BACKTO 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^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
K ^TMP("ORWGRPC TEMP",$J),^TMP("TIUR",$J)
Q
;
ORDER(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
N DATE,DATE2,NODE,ORUPCHUK,RESULT,VALUE K ORUPCHUK
S DATE="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
F S DATE=$O(^PXRMINDX(100,"PI",DFN,ITEM,DATE)) Q:DATE="" D
. I DATE>START Q
. I DATE<BACKTO 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^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
Q
;
RAD(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(70,"PI",DFN,ITEM,DATE)) Q:DATE="" D
. I DATE>START Q
. I DATE<BACKTO Q
. S NODE=""
. F S NODE=$O(^PXRMINDX(70,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
.. D RAD^ORWGAPIA(NODE,.VALUE,.VALUES) S VALUE=$G(VALUE("PDX"))_"-"_$G(VALUE("EXAM STATUS"))_U_U_VALUES
.. S RESULT=70_U_ITEM_U_DATE_U_DATE2_U_VALUE
.. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWGAPI3 5433 printed Oct 16, 2024@18:36:47 Page 2
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
+2 ;
+3 ;
ADVERSE(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
+1 NEW ADVERSE,DATE,DATE2,NODE,RESULT,RXN,VALUE
+2 SET DATE=""
SET DATE2=""
SET CNT=$GET(CNT)
SET BACKTO=+$GET(BACKTO)
+3 SET ADVERSE=""
+4 SET VALUE=ITEM_U_ITEM
+5 SET NODE=""
+6 FOR
SET NODE=$ORDER(^GMR(120.8,"B",DFN,NODE))
if NODE=""
QUIT
Begin DoDot:1
+7 IF '$DATA(^GMR(120.8,NODE,0))
QUIT
+8 ; entered in error
IF $GET(^GMR(120.8,NODE,"ER"))
QUIT
+9 ; signed
IF '$PIECE(^GMR(120.8,NODE,0),U,12)
QUIT
+10 SET DATE=+$PIECE($GET(^GMR(120.8,NODE,0)),U,4)
IF 'DATE
QUIT
+11 IF DATE>START
QUIT
+12 IF DATE<BACKTO
QUIT
+13 IF ITEM'=$PIECE(^GMR(120.8,NODE,0),U,2)
QUIT
+14 SET RXN=0
+15 FOR
SET RXN=$ORDER(^GMR(120.8,NODE,10,"B",RXN))
if RXN<1
QUIT
Begin DoDot:2
+16 SET ADVERSE=ADVERSE_$$EVALUE^ORWGAPIU(RXN,120.8)_", "
End DoDot:2
+17 IF $LENGTH(ADVERSE)>0
SET ADVERSE=$EXTRACT(ADVERSE,1,$LENGTH(ADVERSE)-2)
+18 SET CNT=CNT+1
+19 SET RESULT=120.8_U_ITEM_U_DATE_U_DATE2_U_ADVERSE
+20 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:1
+21 QUIT
+22 ;
DX(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
+1 NEW DATE,DATE2,NODE,NUM,RESULT,VALUE,VALUES
KILL VALUE
+2 KILL ^TMP("ORWGRPC TEMP",$JOB)
+3 SET DATE2=""
SET CNT=$GET(CNT)
SET BACKTO=+$GET(BACKTO)
+4 SET NUM=""
+5 FOR
SET NUM=$ORDER(^PXRMINDX(45,"ICD9","PNI",DFN,NUM))
if NUM=""
QUIT
Begin DoDot:1
+6 SET DATE=""
+7 FOR
SET DATE=$ORDER(^PXRMINDX(45,"ICD9","PNI",DFN,NUM,ITEM,DATE))
if DATE=""
QUIT
Begin DoDot:2
+8 IF DATE>START
QUIT
+9 IF DATE<BACKTO
QUIT
+10 SET NODE=""
+11 FOR
SET NODE=$ORDER(^PXRMINDX(45,"ICD9","PNI",DFN,NUM,ITEM,DATE,NODE))
if NODE=""
QUIT
Begin DoDot:3
+12 IF '$DATA(^TMP("ORWGRPC TEMP",$JOB,ITEM,DATE))
SET ^TMP("ORWGRPC TEMP",$JOB,ITEM,DATE)=NODE_U_NUM
End DoDot:3
End DoDot:2
End DoDot:1
+13 SET ITEM=""
+14 FOR
SET ITEM=$ORDER(^TMP("ORWGRPC TEMP",$JOB,ITEM))
if ITEM=""
QUIT
Begin DoDot:1
+15 SET DATE=""
+16 FOR
SET DATE=$ORDER(^TMP("ORWGRPC TEMP",$JOB,ITEM,DATE))
if DATE=""
QUIT
Begin DoDot:2
+17 SET NODE=$GET(^TMP("ORWGRPC TEMP",$JOB,ITEM,DATE))
IF '$LENGTH(NODE)
QUIT
+18 SET NUM=$PIECE(NODE,U,2)
+19 SET NODE=$PIECE(NODE,U)
+20 ; ****** remove this when PTF patch is released **********
IF '$LENGTH($GET(^DGPT(+NODE,0)))
QUIT
+21 DO PTF^ORWGAPIA(NODE,.VALUE,.VALUES)
SET VALUE=$$EXT^ORWGAPIX($GET(VALUE("DISCHARGE STATUS")),45,6)
+22 ;*****************************
IF NUM="DXLS"
SET VALUE="(DXLS) "_VALUE_U_U_VALUES
+23 SET RESULT=45_"DX"_U_ITEM_U_DATE_U_DATE2_U_" "_VALUE
+24 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:2
End DoDot:1
+25 KILL ^TMP("ORWGRPC TEMP",$JOB)
+26 QUIT
+27 ;
LAB(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
+1 NEW COMMENT,DATE,DATE2,NODE,RESULT,TYPE,VALUE
KILL VALUE
+2 SET DATE=""
SET DATE2=""
SET CNT=$GET(CNT)
SET BACKTO=+$GET(BACKTO)
+3 Begin DoDot:1
+4 IF $EXTRACT(ITEM)="A"
SET TYPE="AP"
QUIT
+5 IF $EXTRACT(ITEM)="M"
SET TYPE="MI"
QUIT
+6 SET TYPE=""
QUIT
End DoDot:1
+7 FOR
SET DATE=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM,DATE))
if DATE=""
QUIT
Begin DoDot:1
+8 IF DATE>START
QUIT
+9 IF DATE<BACKTO
QUIT
+10 SET NODE=""
+11 FOR
SET NODE=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM,DATE,NODE))
if NODE=""
QUIT
Begin DoDot:2
+12 KILL VALUE
+13 DO LAB^ORWGAPIC(.VALUE,NODE,ITEM)
+14 ;_U_$P(VALUE,U,2)
IF TYPE="AP"
SET RESULT="63AP^"_ITEM_U_DATE_U_DATE2
+15 IF TYPE="MI"
SET RESULT="63MI^"_ITEM_U_DATE_U_DATE2_U_$PIECE(VALUE,U,4)
+16 IF TYPE=""
Begin DoDot:3
+17 SET COMMENT=""
+18 IF $LENGTH($GET(VALUE("COMMENTS",1)))
SET COMMENT=1
+19 SET RESULT="63^"_ITEM_U_DATE_U_DATE2_U_$PIECE(VALUE,U,3)_U_$PIECE(VALUE,U,4)_U_$GET(VALUE("SPECIMEN"))_U_COMMENT
+20 IF $LENGTH($PIECE(VALUE,U,7))
SET $PIECE(RESULT,U,10)=$PIECE($PIECE(VALUE,U,7),"!",2,3)_U_$PIECE($PIECE(VALUE,U,7),"!",7)
End DoDot:3
+21 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
MED(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
+1 DO MED3^ORWGAPIE(.DATA,ITEM,START,DFN,.CNT,.TMP)
+2 QUIT
+3 ;
NOTE(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
+1 NEW DATE,DOC,DOCCLASS,DOCTYPE,DUM,IEN,RESULT,RESULTS,TITLE,VALUE
KILL DUM
+2 KILL ^TMP("ORWGRPC TEMP",$JOB),^TMP("TIUR",$JOB)
+3 SET CNT=$GET(CNT)
SET ITEM=$$UP^ORWGAPIX(ITEM)
SET BACKTO=+$GET(BACKTO)
+4 FOR DOCTYPE="P","D","C"
Begin DoDot:1
+5 SET DOCCLASS=$$DOCCLASS^ORWGAPIA(DOCTYPE)
+6 KILL ^TMP("TIUR",$JOB)
+7 DO TIU^ORWGAPIA(.DUM,DOCCLASS,5,DFN)
+8 SET DOC=0
+9 FOR
SET DOC=$ORDER(^TMP("TIUR",$JOB,DOC))
if DOC<1
QUIT
Begin DoDot:2
+10 SET RESULTS=^TMP("TIUR",$JOB,DOC)
+11 SET IEN=+$PIECE(RESULTS,U)
+12 SET TITLE=$$UP^ORWGAPIX($PIECE(RESULTS,U,2))
+13 IF TITLE'=ITEM
QUIT
+14 ; do not use admission date S DATE=$P($G(^AUPNVSIT(+$P($G(^TIU(8925,IEN,0)),U,3),0)),U)
+15 SET DATE=$PIECE(RESULTS,U,3)
+16 IF DATE>START
QUIT
+17 IF DATE<BACKTO
QUIT
+18 SET VALUE=$PIECE(RESULTS,U,7)
+19 SET CNT=CNT+1
+20 SET RESULT=8925_U_TITLE_U_DATE_"^^"_VALUE
+21 IF $DATA(^TMP("ORWGRPC TEMP",$JOB,RESULT))
QUIT
+22 SET ^TMP("ORWGRPC TEMP",$JOB,RESULT)=""
+23 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:2
End DoDot:1
+24 KILL ^TMP("ORWGRPC TEMP",$JOB),^TMP("TIUR",$JOB)
+25 QUIT
+26 ;
ORDER(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
+1 NEW DATE,DATE2,NODE,ORUPCHUK,RESULT,VALUE
KILL ORUPCHUK
+2 SET DATE=""
SET CNT=$GET(CNT)
SET BACKTO=+$GET(BACKTO)
+3 FOR
SET DATE=$ORDER(^PXRMINDX(100,"PI",DFN,ITEM,DATE))
if DATE=""
QUIT
Begin DoDot:1
+4 IF DATE>START
QUIT
+5 IF DATE<BACKTO
QUIT
+6 SET DATE2=""
+7 FOR
SET DATE2=$ORDER(^PXRMINDX(100,"PI",DFN,ITEM,DATE,DATE2))
if DATE2=""
QUIT
Begin DoDot:2
+8 SET NODE=""
+9 FOR
SET NODE=$ORDER(^PXRMINDX(100,"PI",DFN,ITEM,DATE,DATE2,NODE))
if NODE=""
QUIT
Begin DoDot:3
+10 DO EN^ORX8($PIECE(NODE,";"))
SET VALUE=$PIECE($GET(ORUPCHUK("ORSTS")),U,2)
+11 SET RESULT=100_U_ITEM_U_DATE_"^^"_VALUE
+12 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
RAD(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(70,"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(70,"PI",DFN,ITEM,DATE,NODE))
if NODE=""
QUIT
Begin DoDot:2
+8 DO RAD^ORWGAPIA(NODE,.VALUE,.VALUES)
SET VALUE=$GET(VALUE("PDX"))_"-"_$GET(VALUE("EXAM STATUS"))_U_U_VALUES
+9 SET RESULT=70_U_ITEM_U_DATE_U_DATE2_U_VALUE
+10 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
