284 lines
9.2 KiB
Mathematica
284 lines
9.2 KiB
Mathematica
ORWGAPID ; SLC/STAFF - Graph API Details ;12/21/05 08:19
|
|
;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
|
|
;
|
|
DETAILS(DATA,DFN,DATE1,DATE2,FILEITEM) ; from ORWGAPI (series click)
|
|
N ITEM,FILE,SUBHEAD,TYPEITEM K SUBHEAD,TYPEITEM
|
|
K ^TMP("LR7OGX",$J),^TMP("LRC",$J)
|
|
K ^TMP("ORLRC",$J),^TMP("PSBO",$J),^TMP("TIUVIEW",$J)
|
|
S FILE=$P(FILEITEM,U)
|
|
S ITEM=$$UP^ORWGAPIX($P(FILEITEM,U,2))
|
|
I '$L(ITEM) Q
|
|
D
|
|
. I FILE=63 D Q
|
|
.. D INTERIM^ORWLRR(.DATA,DFN,DATE1,DATE2)
|
|
.. M ^TMP("ORWGRPC",$J)=^TMP("LR7OGX",$J,"OUTPUT")
|
|
. I FILE="63MI" D Q
|
|
.. D MICRO^ORWLRR(.DATA,DFN,DATE1,DATE2)
|
|
.. M ^TMP("ORWGRPC",$J)=^TMP("LR7OGX",$J,"OUTPUT")
|
|
. I FILE="63AP" D Q
|
|
.. S SUBHEAD("CYTOPATHOLOGY")=""
|
|
.. S SUBHEAD("SURGICAL PATHOLOGY")=""
|
|
.. S SUBHEAD("EM")=""
|
|
.. S SUBHEAD("AUTOPSY")=""
|
|
.. D LABSUM^ORWGAPIA(.DATA,DFN,DATE1,DATE2,.SUBHEAD)
|
|
.. M ^TMP("ORWGRPC",$J)=^TMP("LRC",$J)
|
|
. I FILE="63BB" D Q
|
|
.. D BLR^ORWRP1(.DATA,DFN,"",DATE1,DATE2)
|
|
.. M ^TMP("ORWGRPC",$J)=^TMP("ORLRC",$J)
|
|
. I FILE="53.79" D Q
|
|
.. D BCMA1^ORWRP1A(.DATA,DFN,"",DATE1,DATE2)
|
|
.. M ^TMP("ORWGRPC",$J)=^TMP("PSBO",$J)
|
|
. I FILE="8925" D Q
|
|
.. D NOTE(.DATA,DFN,DATE1,DATE2,ITEM)
|
|
.. ;M ^TMP("ORWGRPC",$J)=^TMP("TIUVIEW",$J)
|
|
. S TYPEITEM(1)=FILE_"^0"
|
|
. D DETAIL(.DATA,DFN,DATE1,DATE2,.TYPEITEM)
|
|
K ^TMP("LR7OGX",$J),^TMP("LRC",$J)
|
|
K ^TMP("ORLRC",$J),^TMP("PSBO",$J),^TMP("TIUVIEW",$J)
|
|
Q
|
|
;
|
|
DETAIL(DATA,DFN,DATE1,DATE2,TYPEITEM) ; from ORWGAPI (legend click)
|
|
N CNT,FILE,GMTSPX1,GMTSPX2,ITEM,TITEMS,TYPE
|
|
N COMP,NEWITEMS K COMP,NEWITEMS
|
|
K ^TMP("ORDATA",$J)
|
|
S DFN=+$G(DFN) I 'DFN Q
|
|
I '$L($O(TYPEITEM(0))) Q
|
|
S TYPE=""
|
|
F S TYPE=$O(TYPEITEM(TYPE)) Q:TYPE="" D
|
|
. S TITEMS=TYPEITEM(TYPE)
|
|
. S FILE=$P(TITEMS,U) I '$L(FILE) Q
|
|
. S ITEM=$P(TITEMS,U,2) I '$L(ITEM) Q
|
|
. S NEWITEMS(FILE,ITEM)=""
|
|
S CNT=0
|
|
S FILE=""
|
|
F S FILE=$O(NEWITEMS(FILE)) Q:FILE="" D
|
|
. S CNT=CNT+1
|
|
. S COMP(CNT)=$$COMPTYPE^ORWGAPIT(FILE)
|
|
S GMTSPX1=DATE1,GMTSPX2=DATE2
|
|
D REPORT^ORWRP2(.DATA,.COMP,DFN)
|
|
M ^TMP("ORWGRPC",$J)=^TMP("ORDATA",$J)
|
|
K ^TMP("ORDATA",$J)
|
|
Q
|
|
;
|
|
NOTE(DATA,DFN,DATE1,DATE2,ITEM) ;
|
|
N CNT,DATE,DOC,DOCCLASS,DOCTYPE,DUM,IEN,LINE,NUM,RESULTS K DUM
|
|
K ^TMP("TIUR",$J),^TMP("TIUVIEW",$J)
|
|
S CNT=$G(CNT)
|
|
F DOCTYPE="P","D","C" D
|
|
. S DOCCLASS=$$DOCCLASS^ORWGAPIA(DOCTYPE)
|
|
. K ^TMP("TIUR",$J)
|
|
. D TIU^ORWGAPIA(.DUM,DOCCLASS,5,DFN,DATE1,DATE2)
|
|
. 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)
|
|
.. K ^TMP("TIUVIEW",$J)
|
|
.. D GETTIU^ORWGAPIA(.DATA,IEN)
|
|
.. S NUM=0
|
|
.. F S NUM=$O(^TMP("TIUVIEW",$J,NUM)) Q:NUM<1 D
|
|
... S LINE=$G(^TMP("TIUVIEW",$J,NUM))
|
|
... S CNT=CNT+1
|
|
... S ^TMP("ORWGRPC",$J,CNT)=LINE
|
|
.. I CNT>1 D
|
|
... S CNT=CNT+1
|
|
... S ^TMP("ORWGRPC",$J,CNT)=" "
|
|
... S CNT=CNT+1
|
|
... S ^TMP("ORWGRPC",$J,CNT)=" "
|
|
K ^TMP("TIUR",$J),^TMP("TIUVIEW",$J)
|
|
Q
|
|
;
|
|
TAX(DATA,ALL,REMTAX) ; from ORWGAPI
|
|
N CNT,REM,CODE,NUM,TMP
|
|
K ^TMP("ORWG TEMP",$J)
|
|
D RETURN^ORWGAPIU(.TMP,.DATA)
|
|
S CNT=0
|
|
S REM=0
|
|
I ALL F S REM=$O(^PXD(811.2,REM)) Q:REM<1 D TEMP(REM)
|
|
I 'ALL D
|
|
. S NUM=0
|
|
. F S NUM=$O(REMTAX(NUM)) Q:NUM<1 D
|
|
.. S REM=REMTAX(NUM)
|
|
.. D TEMP(REM)
|
|
S CODE=""
|
|
F S CODE=$O(^TMP("ORWG TEMP",$J,CODE)) Q:CODE="" D
|
|
. D SETUP^ORWGAPIU(.DATA,CODE,TMP,.CNT)
|
|
K ^TMP("ORWG TEMP",$J)
|
|
Q
|
|
;
|
|
TEMP(REM) ;
|
|
N NODE,NUM,SUB
|
|
I $P($G(^PXD(811.2,REM,0)),U,6)=1 Q
|
|
F SUB=80,80.1,81 D
|
|
. S NUM=0
|
|
. F S NUM=$O(^PXD(811.3,REM,SUB,NUM)) Q:NUM<1 D
|
|
.. S NODE=+$G(^PXD(811.3,REM,SUB,NUM,0))
|
|
.. I 'NODE Q
|
|
.. I SUB=80 D Q
|
|
... S ^TMP("ORWG TEMP",$J,"45DX;"_NODE)=""
|
|
... S ^TMP("ORWG TEMP",$J,"9000010.07;"_NODE)=""
|
|
... S ^TMP("ORWG TEMP",$J,"9000011;"_NODE)=""
|
|
.. I SUB=80.1 D Q
|
|
... S ^TMP("ORWG TEMP",$J,"45OP;"_NODE)=""
|
|
.. I SUB=81 D Q
|
|
... S ^TMP("ORWG TEMP",$J,"9000010.18;"_NODE)=""
|
|
Q
|
|
;
|
|
MED1(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
|
|
N DATE,ITEM,OK,MEDARRAY,RESULT K MEDARRAY
|
|
D MEDICINE^ORWGAPIA(.MEDARRAY,DFN)
|
|
S ITEM=0
|
|
F S ITEM=$O(MEDARRAY(ITEM)) Q:ITEM<1 D
|
|
. S OK=0
|
|
. I FMT=6 D
|
|
.. S DATE=OLDEST
|
|
.. F S DATE=$O(MEDARRAY(ITEM,DATE)) Q:DATE="" Q:DATE>NEWEST D Q:OK
|
|
... S CNT=CNT+1
|
|
... S OK=1
|
|
... S RESULT=690_U_ITEM
|
|
... D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
|
|
. I FMT'=6 D
|
|
.. S DATE=$O(MEDARRAY(ITEM,""),-1)
|
|
.. I 'DATE Q
|
|
.. S NAME=MEDARRAY(ITEM,DATE)
|
|
.. I '$L(NAME) Q
|
|
.. S CNT=CNT+1
|
|
.. S OK=1
|
|
.. I FMT=3 S RESULT=690_U_ITEM_"^^"_NAME_"^^"_DATE
|
|
.. I FMT=0 S RESULT=690_U_ITEM_U_NAME
|
|
. I OK D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
|
|
Q
|
|
;
|
|
MED3(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
|
|
N DATE,DATE2,DATESTOP,DATESTRT,DTPLUS1,NODE,RESULT,STATUS,VALUE K VALUE
|
|
D MEDICINE^ORWGAPIA(.MEDARRAY,DFN)
|
|
S ITEM=+$G(ITEM)
|
|
S CNT=$G(CNT)
|
|
S DATE=""
|
|
F S DATE=$O(MEDARRAY(ITEM,DATE)) Q:DATE="" D
|
|
. I DATE>START Q
|
|
. S RESULT=690_U_ITEM_U_DATE_"^^"
|
|
. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
|
|
Q
|
|
;
|
|
NVA1(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
|
|
N DATA,DATE,DATE1,DATESTRT,DRUG,ITEM,OK,REF,RESULT K DATA
|
|
S ITEM=""
|
|
F S ITEM=$O(^PXRMINDX("55NVA","PI",DFN,ITEM)) Q:ITEM="" D
|
|
. S OK=0
|
|
. I FMT=6 D
|
|
.. S DATE=0
|
|
.. F S DATE=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE)) Q:DATE="" Q:DATE>NEWEST D Q:OK
|
|
... S DATE1=""
|
|
... F S DATE1=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE,DATE1)) Q:DATE1="" D Q:OK
|
|
.... I DATE1'["U",DATE1<OLDEST Q
|
|
.... S CNT=CNT+1
|
|
.... S OK=1
|
|
.... S RESULT="55NVA"_U_ITEM
|
|
. I FMT'=6 D
|
|
.. S DATE=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,""),-1)
|
|
.. I 'DATE Q
|
|
.. S DATE1=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE,""),-1)
|
|
.. I '$L(DATE1) Q
|
|
.. S REF=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE,DATE1,""),-1)
|
|
.. I '$L(REF) Q
|
|
.. D RXNVA^ORWGAPIA(REF,.DATA)
|
|
.. S DRUG=+$G(DATA("DISPENSE DRUG"))
|
|
.. S DATESTRT=+$G(DATA("START DATE"))
|
|
.. I 'DATESTRT Q
|
|
.. S CNT=CNT+1
|
|
.. S OK=1
|
|
.. I FMT=3 S RESULT="55NVA"_U_ITEM_"^^"_$$EVALUE^ORWGAPIU(ITEM,"55NVA",.01)_"^^"_DATESTRT
|
|
.. I FMT=0 S RESULT="55NVA"_U_ITEM_U_$$EVALUE^ORWGAPIU(ITEM,"55NVA",.01)
|
|
.. I DRUG S RESULT=RESULT_U_$$DRGCLASS^ORWGAPIA(DRUG)
|
|
. I OK D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
|
|
Q
|
|
;
|
|
NVA3(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
|
|
N DATE1,DATE2,DATESTOP,DATESTRT,DTPLUS1,NODE,RESULT,STATUS,VALUE K VALUE
|
|
S CNT=$G(CNT),DTPLUS1=$$FMADD^ORWGAPIX(DT,1)
|
|
S DATE1=""
|
|
F S DATE1=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE1)) Q:DATE1="" D
|
|
. I DATE1>START Q
|
|
. S DATE2=""
|
|
. F S DATE2=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE1,DATE2)) Q:DATE2="" D
|
|
.. S NODE=""
|
|
.. F S NODE=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE1,DATE2,NODE)) Q:NODE="" D
|
|
... D RXNVA^ORWGAPIA(NODE,.VALUE)
|
|
... S STATUS=$G(VALUE("STATUS"))
|
|
... S DATESTRT=+$G(VALUE("START DATE"))
|
|
... I 'DATESTRT Q
|
|
... S DATESTOP=+$G(VALUE("DISCONTINUED DATE"))
|
|
... I 'DATESTOP S DATESTOP=DTPLUS1
|
|
... S STATUS=STATUS_" "_$$NVASIG^ORWGAPIA(NODE)
|
|
... S RESULT="55NVA"_U_ITEM_U_DATESTRT_U_DATESTOP_U_STATUS
|
|
... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
|
|
Q
|
|
;
|
|
PLX2(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
|
|
N DATE,DTPLUS1,ICD9,OK,PRIORITY,RESULT,STATUS
|
|
K ^TMP("ORWGRPC TEMP",$J)
|
|
S DTPLUS1=$$FMADD^ORWGAPIX(DT,1)
|
|
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 ITEM=""
|
|
.. F S ITEM=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM)) Q:ITEM="" D
|
|
... S DATE=""
|
|
... F S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE)) Q:DATE="" D
|
|
.... S NODE=""
|
|
.... F S NODE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,NODE)) Q:NODE="" D
|
|
..... D PROB^ORWGAPIA(.PROB,.PSTATUS,.PROBDX,.DTONSET,.DTRESOLV,NODE)
|
|
..... I 'DTRESOLV S ^TMP("ORWGRPC TEMP",$J,PROBDX,DTONSET)=DTPLUS1 Q
|
|
..... S ^TMP("ORWGRPC TEMP",$J,PROBDX,DTONSET)=DTRESOLV
|
|
S PROB=""
|
|
F S PROB=$O(^TMP("ORWGRPC TEMP",$J,PROB)) Q:PROB="" D
|
|
. S VALUE=$$EVALUE^ORWGAPIU(PROB,9000011,.01)
|
|
. I FMT=0 D
|
|
.. S CNT=CNT+1
|
|
.. S RESULT=9999911_U_PROB_U_VALUE
|
|
.. D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
|
|
. I FMT=6 D
|
|
.. S OK=0
|
|
.. S DATE=0
|
|
.. F S DATE=$O(^TMP("ORWGRPC TEMP",$J,PROB,DATE)) Q:DATE="" Q:DATE>NEWEST D Q:OK
|
|
... S DTRESOLV=^TMP("ORWGRPC TEMP",$J,PROB,DATE)
|
|
... I DTRESOLV<OLDEST Q
|
|
... S CNT=CNT+1
|
|
... S OK=1
|
|
... S RESULT=9999911_U_PROB
|
|
.. I OK D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
|
|
. I FMT=3 D
|
|
.. S DATE=$O(^TMP("ORWGRPC TEMP",$J,PROB,""),-1)
|
|
.. I 'DATE Q
|
|
.. S CNT=CNT+1
|
|
.. S RESULT=9999911_U_PROB_"^^"_VALUE_"^^"_DATE
|
|
.. D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
|
|
K ^TMP("ORWGRPC TEMP",$J)
|
|
Q
|
|
;
|
|
PROBX4(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
|
|
N DATE,DTONSET,DTPLUS1,DTRESOLV,ICD9,NODE,PRIORITY,PROB,PROBDX,PSTATUS,RESULT,STATUS,VALUE
|
|
K ^TMP("ORWGRPC TEMP",$J)
|
|
S CNT=$G(CNT),DTPLUS1=$$FMADD^ORWGAPIX(DT,1)
|
|
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
|
|
... S NODE=""
|
|
... F S NODE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,NODE)) Q:NODE="" D
|
|
.... S ^TMP("ORWGRPC TEMP",$J,NODE)=""
|
|
S NODE=""
|
|
F S NODE=$O(^TMP("ORWGRPC TEMP",$J,NODE)) Q:NODE="" D
|
|
. D PROB^ORWGAPIA(.PROB,.PSTATUS,.PROBDX,.DTONSET,.DTRESOLV,NODE)
|
|
. I 'DTONSET Q
|
|
. I 'DTRESOLV S DTRESOLV=DTPLUS1
|
|
. S RESULT=9999911_U_PROBDX_U_DTONSET_U_DTRESOLV_U_$$EXT^ORWGAPIX(PSTATUS,9000011,.12)
|
|
. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
|
|
K ^TMP("ORWGRPC TEMP",$J)
|
|
Q
|
|
;
|