source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWGAPI2.m@ 949

ORWGAPI2 ; SLC/STAFF - Graph API Items ;12/21/05  08:16
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
 ;
ADMITS(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
 N DATE,DATE2,DISCH,LINE,LST,NUM,OK,RESULT K LST
 K ^TMP("ORWGRPC TEMP",$J)
 D ADMITLST^ORWPT(.LST,DFN)
 S OK=0
 S NUM=0
 F  S NUM=$O(LST(NUM)) Q:NUM<1  D  Q:OK
 . S LINE=LST(NUM)
 . S DATE=$P(LINE,U)
 . S DISCH=$P(LINE,U,5)
 . S DATE2=$$DISCH^ORWGAPIA(DISCH)
 . I DATE2="" S DATE2=DATE2\1
 . I FMT=6 D  Q
 .. I DATE>NEWEST Q
 .. I DATE2>0,DATE2<OLDEST Q
 .. I $D(^TMP("ORWGRPC TEMP",$J,"ADMIT")) Q
 .. S ^TMP("ORWGRPC TEMP",$J,"ADMIT")=""
 .. S CNT=CNT+1
 .. S OK=1
 .. S RESULT="405^ADMIT"
 . I FMT=3 D  Q
 .. I $D(^TMP("ORWGRPC TEMP",$J,"ADMIT")) Q
 .. S ^TMP("ORWGRPC TEMP",$J,"ADMIT")=""
 .. S CNT=CNT+1
 .. S OK=1
 .. S RESULT="405^ADMIT^^ADMIT^^"_DATE
 . I FMT=0 D  Q
 .. S ^TMP("ORWGRPC TEMP",$J,"ADMIT")=""
 .. S CNT=CNT+1
 .. S OK=1
 .. S RESULT="405^ADMIT^ADMIT"
 I OK D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
 K ^TMP("ORWGRPC TEMP",$J)
 Q
 ;
ADVERSE(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
 N DATE,IEN,ITEM,RESULT
 K ^TMP("ORWGRPC SORT",$J),^TMP("ORWGRPC TEMP",$J)
 S IEN=0
 F  S IEN=$O(^GMR(120.8,"B",DFN,IEN)) Q:IEN<1  D
 . I '$D(^GMR(120.8,IEN,0)) Q
 . I $G(^GMR(120.8,IEN,"ER")) Q
 . I '$P(^GMR(120.8,IEN,0),U,12) Q
 . S DATE=+$P($G(^GMR(120.8,IEN,0)),U,4) I 'DATE Q
 . S ITEM=$P(^GMR(120.8,IEN,0),U,2) I '$L(ITEM) Q
 . S ^TMP("ORWGRPC SORT",$J,DATE,ITEM)="" ;ADVERSE
 I FMT=6 D
 . S DATE=OLDEST
 . F  S DATE=$O(^TMP("ORWGRPC SORT",$J,DATE)) Q:DATE<1  Q:DATE>NEWEST  D
 .. S ITEM=""
 .. F  S ITEM=$O(^TMP("ORWGRPC SORT",$J,DATE,ITEM)) Q:ITEM=""  D
 ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
 ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
 ... S CNT=CNT+1
 ... S RESULT="120.8^"_ITEM
 ... D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
 I FMT'=6 D
 . S DATE=0
 . F  S DATE=$O(^TMP("ORWGRPC SORT",$J,DATE)) Q:DATE<1  D
 .. S ITEM=""
 .. F  S ITEM=$O(^TMP("ORWGRPC SORT",$J,DATE,ITEM)) Q:ITEM=""  D
 ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
 ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
 ... S CNT=CNT+1
 ... I FMT=3 S RESULT="120.8^"_ITEM_"^^"_ITEM_"^^"_DATE
 ... I FMT=0 S RESULT="120.8^"_ITEM_U_ITEM
 ... D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
 K ^TMP("ORWGRPC SORT",$J),^TMP("ORWGRPC TEMP",$J)
 Q
 ;
PL(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
 N DATE,ICD9,OK,PRIORITY,RESULT,STATUS
 K ^TMP("ORWGRPC TEMP",$J)
 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 ICD9=""
 .. F  S ICD9=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ICD9)) Q:ICD9=""  D
 ... S OK=0
 ... I FMT=6 D
 .... S DATE=OLDEST
 .... F  S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ICD9,DATE)) Q:DATE=""  Q:DATE>NEWEST  D  Q:OK
 ..... S CNT=CNT+1
 ..... S OK=1
 ..... S RESULT=9000011_U_ICD9
 ... I FMT=3 D
 .... S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ICD9,""),-1)
 .... I DATE S ^TMP("ORWGRPC TEMP",$J,ICD9,DATE)=""
 ... I FMT=0 D
 .... S CNT=CNT+1
 .... S OK=1
 .... S RESULT=9000011_U_ICD9_U_$$EVALUE^ORWGAPIU(ICD9,9000011,.01)
 ... I OK D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
 I FMT=3 D
 . S ICD9=""
 . F  S ICD9=$O(^TMP("ORWGRPC TEMP",$J,ICD9)) Q:ICD9=""  D
 .. S DATE=$O(^TMP("ORWGRPC TEMP",$J,ICD9,""),-1)
 .. I 'DATE Q
 .. S CNT=CNT+1
 .. S RESULT=9000011_U_ICD9_"^^"_$$EVALUE^ORWGAPIU(ICD9,9000011,.01)_"^^"_DATE
 .. D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
 K ^TMP("ORWGRPC TEMP",$J)
 Q
 ;
PLX(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
 D PLX2^ORWGAPID(.ITEMS,DFN,FMT,OLDEST,NEWEST,.CNT,.TMP)
 Q
 ;
REG(ITEMS,DFN,FILE,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
 N DATE,ICD,ITEM,NUM,OK,RESULT
 K ^TMP("ORWGRPC TEMP",$J)
 I $E(FILE,3,4)="DX" S ICD="ICD9"
 I $E(FILE,3,4)="OP" S ICD="ICD0"
 S NUM=""
 F  S NUM=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM)) Q:NUM=""  D
 . S ITEM=""
 . F  S ITEM=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM,ITEM)) Q:ITEM=""  D
 .. S OK=0
 .. I FMT=6 D
 ... S DATE=OLDEST
 ... F  S DATE=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM,ITEM,DATE)) Q:DATE=""  Q:DATE>NEWEST  D  Q:OK
 .... S CNT=CNT+1
 .... S OK=1
 .... S RESULT=FILE_U_ITEM
 .. I FMT=3 D
 ... S DATE=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM,ITEM,""),-1)
 ... I DATE S ^TMP("ORWGRPC TEMP",$J,ITEM,DATE)=""
 .. I FMT=0 D
 ... S CNT=CNT+1
 ... S OK=1
 ... S RESULT=FILE_U_ITEM_U_$$EVALUE^ORWGAPIU(ITEM,45_";"_ICD,.01)
 .. I OK D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
 I FMT=3 D
 . S ITEM=""
 . F  S ITEM=$O(^TMP("ORWGRPC TEMP",$J,ITEM)) Q:ITEM=""  D
 .. S DATE=$O(^TMP("ORWGRPC TEMP",$J,ITEM,""),-1)
 .. I 'DATE Q
 .. S CNT=CNT+1
 .. S RESULT=FILE_U_ITEM_"^^"_$$EVALUE^ORWGAPIU(ITEM,45_";"_ICD,.01)_"^^"_DATE
 .. D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
 K ^TMP("ORWGRPC TEMP",$J)
 Q
 ;
SURGERY(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
 N CASE,DATE,PROC,RESULT,RESULTS,SURG,SURGPROC K SURG,SURGPROC
 D SURG^ORWGAPIA(.SURG,DFN)
 K SURG(0),SURG(1)
 I FMT=6 D
 . 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 DATE=$P(RESULTS,U,5)
 .. I DATE>NEWEST Q
 .. I DATE<OLDEST Q
 .. I $D(SURGPROC(PROC)) Q
 .. S SURGPROC(PROC)=""
 .. S CNT=CNT+1
 .. S RESULT=130_U_PROC
 .. D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
 I FMT'=6 D
 . 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 SURGPROC(PROC)=RESULTS
 . K SURG S PROC=""
 . F  S PROC=$O(SURGPROC(PROC)) Q:PROC=""  D
 .. S CNT=CNT+1
 .. I FMT=3 S RESULT=130_U_PROC_"^^"_PROC_"^^"_$P(SURGPROC(PROC),U,5)
 .. I FMT=0 S RESULT=130_U_PROC_U_PROC
 .. D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
 Q
 ;
TREAT(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR ***** change to inverse dates
 N DATE,IEN,ITEM,OLDEST1,RESULT
 K ^TMP("ORWGRPC TEMP",$J)
 I FMT=6 D
 . S OLDEST1=9999999-OLDEST
 . S DATE=9999999-NEWEST
 . F  S DATE=$O(^AUPNVTRT("AA",DFN,DATE)) Q:DATE<1  Q:DATE>OLDEST1  D
 .. S IEN=0
 .. F  S IEN=$O(^AUPNVTRT("AA",DFN,DATE,IEN)) Q:IEN<1  D
 ... S ITEM=+$G(^AUPNVTRT(IEN,0)) I 'ITEM Q
 ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
 ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
 ... S CNT=CNT+1
 ... S RESULT="9000010.15^"_ITEM
 ... D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
 I FMT'=6 D
 . S OLDEST1=9999999-OLDEST
 . S DATE=9999999-NEWEST
 . F  S DATE=$O(^AUPNVTRT("AA",DFN,DATE)) Q:DATE<1  Q:DATE>OLDEST  D
 .. S IEN=0
 .. F  S IEN=$O(^AUPNVTRT("AA",DFN,DATE,IEN)) Q:IEN<1  D
 ... S ITEM=+$G(^AUPNVTRT(IEN,0)) I 'ITEM Q
 ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
 ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
 ... S CNT=CNT+1
 ... I FMT=3 S RESULT="9000010.15^"_ITEM_"^^"_$$EVALUE^ORWGAPIU(ITEM,9000010.15)_"^^"_DATE
 ... I FMT=0 S RESULT="9000010.15^"_ITEM_U_$$EVALUE^ORWGAPIU(ITEM,9000010.15)
 ... D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
 K ^TMP("ORWGRPC TEMP",$J)
 Q
 ;
VISITS(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
 N DATE,DATE2,ITEM,NODE,NUM,OK,RESULT
 K ^TMP("ORWGRPC TEMP",$J)
 I FMT=6 D
 . S DATE=0
 . F  S DATE=$O(^AUPNVSIT("AET",DFN,DATE)) Q:DATE<1  Q:DATE>NEWEST  D
 .. S ITEM=""
 .. F  S ITEM=$O(^AUPNVSIT("AET",DFN,DATE,ITEM)) Q:ITEM=""  D
 ... 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 ^TMP("ORWGRPC TEMP",$J,ITEM,DATE)=DATE2
 . S ITEM=0
 . F  S ITEM=$O(^TMP("ORWGRPC TEMP",$J,ITEM)) Q:ITEM<1  D
 .. S OK=0
 .. S DATE=0
 .. F  S DATE=$O(^TMP("ORWGRPC TEMP",$J,ITEM,DATE)) Q:DATE<1  Q:DATE>NEWEST  D  Q:OK
 ... S DATE2=$G(^TMP("ORWGRPC TEMP",$J,ITEM,DATE))
 ... I DATE2<OLDEST Q
 ... S CNT=CNT+1
 ... S OK=1
 ... S RESULT="9000010^"_ITEM
 ... D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
 I FMT'=6 D
 . S DATE=0
 . F  S DATE=$O(^AUPNVSIT("AET",DFN,DATE)) Q:DATE<1  D
 .. S ITEM=0
 .. F  S ITEM=$O(^AUPNVSIT("AET",DFN,DATE,ITEM)) Q:ITEM<1  D
 ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
 ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
 ... S CNT=CNT+1
 ... I FMT=3 S RESULT="9000010^"_ITEM_"^^"_$$EVALUE^ORWGAPIU(ITEM,9000010,.22)_"^^"_DATE
 ... I FMT=0 S RESULT="9000010^"_ITEM_U_$$EVALUE^ORWGAPIU(ITEM,9000010,.22)
 ... D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
 K ^TMP("ORWGRPC TEMP",$J)
 Q
 ;