source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWGAPI4.m@ 1499

ORWGAPI4 ; SLC/STAFF - Graph Data ;8/21/06  07:52
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,260**;Dec 17, 1997;Build 26
 ;
ADMIT(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N DATE,DATE2,DISCH,LINE,LST,NUM,RESULT,VALUE K LST
 S ITEM=$G(ITEM,"ADMIT")
 D ADMITLST^ORWPT(.LST,DFN)
 S NUM=0
 F  S NUM=$O(LST(NUM)) Q:NUM<1  D
 . S LINE=LST(NUM)
 . S DATE=$P(LINE,U)
 . I DATE>START Q
 . S DISCH=$P(LINE,U,5)
 . S DATE2=$$DISCH^ORWGAPIA(DISCH)
 . I DATE2="" D
 .. S DATE2=$$FMADD^ORWGAPIX(DATE,$$LOS^ORWGAPIA(DISCH)+1)
 .. I DATE2=-1 S DATE2=$$FMADD^ORWGAPIX(DT,1) ; just make it today + 1
 .. S DATE2=DATE2\1
 . S VALUE=$P(LINE,U,3)_"  "_$P(LINE,U,4)_U_$P(LINE,U,5,6)
 . S CNT=CNT+1
 . S RESULT=405_U_ITEM_U_DATE_U_DATE2_U_VALUE
 . D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 Q
 ;
EDU(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
 S DATE="",DATE2="",CNT=$G(CNT)
 F  S DATE=$O(^PXRMINDX(9000010.16,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
 . I DATE>START Q
 . S NODE=""
 . F  S NODE=$O(^PXRMINDX(9000010.16,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
 .. D EDU^ORWGAPIA(NODE,.VALUE)
 .. S VALUE=VALUE("VALUE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.16,.06)
 .. S RESULT=9000010.16_U_ITEM_U_DATE_"^^" ;_VALUE
 .. S RESULT=9000010.16_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 Q
 ;
EXAM(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
 S DATE="",DATE2="",CNT=$G(CNT)
 F  S DATE=$O(^PXRMINDX(9000010.13,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
 . I DATE>START Q
 . S NODE=""
 . F  S NODE=$O(^PXRMINDX(9000010.13,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
 .. D EXAM^ORWGAPIA(NODE,.VALUE)
 .. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.13,.04)
 .. S RESULT=9000010.13_U_ITEM_U_DATE_U_DATE2_U_VALUE
 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 Q
 ;
HF(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
 S DATE="",DATE2="",CNT=$G(CNT)
 F  S DATE=$O(^PXRMINDX(9000010.23,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
 . I DATE>START Q
 . S NODE=""
 . F  S NODE=$O(^PXRMINDX(9000010.23,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
 .. D HF^ORWGAPIA(NODE,.VALUE)
 .. S VALUE=VALUE("VALUE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.23,.04)
 .. S RESULT=9000010.23_U_ITEM_U_DATE_U_DATE2_U_VALUE
 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 Q
 ;
IMM(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
 S DATE="",DATE2="",CNT=$G(CNT)
 F  S DATE=$O(^PXRMINDX(9000010.11,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
 . I DATE>START Q
 . S NODE=""
 . F  S NODE=$O(^PXRMINDX(9000010.11,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
 .. D IMM^ORWGAPIA(NODE,.VALUE)
 .. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.11,.04)
 .. S CNT=CNT+1
 .. S RESULT=9000010.11_U_ITEM_U_DATE_U_DATE2_U_VALUE
 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 Q
 ;
MH(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
 S DATE="",DATE2="",CNT=$G(CNT)
 F  S DATE=$O(^PXRMINDX(601.2,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
 . I DATE>START Q
 . S NODE=""
 . F  S NODE=$O(^PXRMINDX(601.2,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
 .. D MH^ORWGAPIA(.VALUE,NODE) S VALUE=$P($G(VALUE(2)),U,2,3)
 .. S RESULT=601.2_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 Q
 ;
OP(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N DATE,DATE2,NODE,NUM,RESULT,VALUE K VALUE
 S DATE2="",CNT=$G(CNT)
 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
 .. S NODE=""
 .. F  S NODE=$O(^PXRMINDX(45,"ICD0","PNI",DFN,NUM,ITEM,DATE,NODE)) Q:NODE=""  D
 ... D PTF^ORWGAPIA(NODE,.VALUE) S VALUE=$G(VALUE("DISCHARGE STATUS"))
 ... S RESULT=45_"OP"_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 Q
 ;
POV(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N DATE,DATE2,NODE,RESULT,TYPE,VALUE K VALUE
 S DATE2="",CNT=$G(CNT)
 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
 .. S NODE=""
 .. F  S NODE=$O(^PXRMINDX(9000010.07,"PPI",DFN,TYPE,ITEM,DATE,NODE)) Q:NODE=""  D
 ... D POV^ORWGAPIA(NODE,.VALUE)
 ... S VALUE=VALUE("CLINICAL TERM"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.07,.15)
 ... S CNT=CNT+1
 ... S RESULT=9000010.07_U_ITEM_U_DATE_U_DATE2_U_VALUE
 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 Q
 ;
PROB(DATA,ITEM,START,DFN,CNT,TMP) ; 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)
 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,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_DTONSET_U_DATE2_U_$$EXT^ORWGAPIX(PSTATUS,9000011,.12)
 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 K ^TMP("ORWGRPC TEMP",$J)
 Q
 ;
PROBX(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 D PROBX4^ORWGAPID(.DATA,ITEM,START,DFN,.CNT,.TMP)
 Q
 ;
PROC(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N DATE,DATE2,NODE,RESULT,TYPE,VALUE K VALUE
 S DATE2="",CNT=$G(CNT)
 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
 .. S NODE=""
 .. F  S NODE=$O(^PXRMINDX(9000010.18,"PPI",DFN,TYPE,ITEM,DATE,NODE)) Q:NODE=""  D
 ... D CPT^ORWGAPIA(NODE,.VALUE)
 ... S VALUE=VALUE("PRINCIPAL PROCEDURE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.18,.07)
 ... S RESULT=9000010.18_U_ITEM_U_DATE_U_DATE2_U_VALUE
 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 Q
 ;
SKIN(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
 S DATE="",DATE2="",CNT=$G(CNT)
 F  S DATE=$O(^PXRMINDX(9000010.12,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
 . I DATE>START Q
 . S NODE=""
 . F  S NODE=$O(^PXRMINDX(9000010.12,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
 .. D SKIN^ORWGAPIA(NODE,.VALUE)
 .. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.12,.04)
 .. S CNT=CNT+1
 .. S RESULT=9000010.12_U_ITEM_U_DATE_U_DATE2_U_VALUE
 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 Q
 ;
SURG(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N CASE,DATE,DATE2,NUM,PROC,RESULT,RESULTS,SURG,SURGPROC,VALUE K SURG,SURGPROC
 S DATE2="",CNT=$G(CNT)
 D SURG^ORWGAPIA(.SURG,DFN)
 K SURG(0),SURG(1)
 S ITEM=$$UP^ORWGAPIX(ITEM)
 S NUM=0
 S CASE=0
 F  S CASE=$O(SURG(CASE)) Q:CASE<1  D
 . S RESULTS=SURG(CASE)
 . S PROC=$P(RESULTS,U,3)
 . I '$L(PROC) Q
 . S PROC=$$UP^ORWGAPIX(PROC)
 . I PROC'=ITEM Q
 . S NUM=NUM+1
 . S SURGPROC(PROC,NUM)=RESULTS
 K SURG
 S PROC=""
 F  S PROC=$O(SURGPROC(PROC)) Q:PROC=""  D
 . S NUM=0
 . F  S NUM=$O(SURGPROC(PROC,NUM)) Q:NUM<1  D
 .. S RESULTS=SURGPROC(PROC,NUM)
 .. S DATE=$P(RESULTS,U,5)
 .. I DATE>START Q
 .. S VALUE=""
 .. S RESULT=130_U_PROC_U_DATE_U_DATE2_U_VALUE
 .. S CNT=CNT+1
 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 Q
 ;
TREAT(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N DATE,DATE2,NODE,RESULT,VALUE
 S DATE="",DATE2="",CNT=$G(CNT)
 S NODE=""
 F  S NODE=$O(^AUPNVTRT("C",DFN,NODE)) Q:NODE=""  D
 . I '$D(^AUPNVTRT("B",ITEM,NODE)) Q
 . S DATE=+$G(^AUPNVSIT(+$P($G(^AUPNVTRT(NODE,0)),U,3),0)) I 'DATE Q
 . I DATE>START Q
 . S VALUE=+$P($G(^AUPNVTRT(NODE,0)),U,4)
 . S CNT=CNT+1
 . S RESULT=9000010.15_U_ITEM_U_DATE_U_DATE2_U_VALUE
 . D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 Q
 ;
VISIT(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 N DATE,DATE2,NODE,NUM,RESULT,VALUE
 S DATE="",DATE2="",CNT=$G(CNT)
 F  S DATE=$O(^AUPNVSIT("AET",DFN,DATE)) Q:DATE=""  D
 . I DATE>START Q
 . S NODE=""
 . F  S NODE=$O(^AUPNVSIT("AET",DFN,DATE,ITEM,NODE)) Q:NODE=""  D
 .. S NUM=0
 .. F  S NUM=$O(^AUPNVSIT("AET",DFN,DATE,ITEM,NODE,NUM)) Q:NUM=""  D
 ... S DATE2=+$P($G(^AUPNVSIT(NUM,0)),U,18)
 ... I 'DATE2 S DATE2=DATE+.01
 ... I +$E($P(DATE2,".",2),1,2)>24 S DATE2=(DATE\1)+.2359
 ... S VALUE=""
 ... S CNT=CNT+1
 ... S RESULT=9000010_U_ITEM_U_DATE_U_DATE2_U_VALUE
 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 Q
 ;
VITAL(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
 I ITEM=99999 D BMIDATA^ORWGAPIX(.DATA,ITEM,START,DFN,.CNT,TMP) Q
 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
 S DATE="",DATE2="",CNT=$G(CNT)
 F  S DATE=$O(^PXRMINDX(120.5,"PI",DFN,ITEM,DATE)) Q:DATE=""  D
 . I DATE>START Q
 . S NODE=""
 . F  S NODE=$O(^PXRMINDX(120.5,"PI",DFN,ITEM,DATE,NODE)) Q:NODE=""  D
 .. D VITAL^ORWGAPIA(.VALUE,NODE) 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
 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
 Q
 ;