Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORWGAPI6

ORWGAPI6.m

Go to the documentation of this file.
  1. ORWGAPI6 ; SLC/STAFF - Graph API Items, non-indexed ;12/21/05 08:16
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
  1. ;
  1. ADMITS(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
  1. N DATE,DATE2,DISCH,LINE,LST,NUM,OK,RESULT K LST
  1. K ^TMP("ORWGRPC TEMP",$J)
  1. D ADMITLST^ORWPT(.LST,DFN)
  1. S OK=0
  1. S NUM=0
  1. F S NUM=$O(LST(NUM)) Q:NUM<1 D Q:OK
  1. . S LINE=LST(NUM)
  1. . S DATE=$P(LINE,U)
  1. . S DISCH=$P(LINE,U,5)
  1. . S DATE2=$$DISCH^ORWGAPIA(DISCH)
  1. . I DATE2="" S DATE2=DATE2\1
  1. . I FMT=6 D Q
  1. .. I DATE>NEWEST Q
  1. .. I DATE2>0,DATE2<OLDEST Q
  1. .. I $D(^TMP("ORWGRPC TEMP",$J,"ADMIT")) Q
  1. .. S ^TMP("ORWGRPC TEMP",$J,"ADMIT")=""
  1. .. S CNT=CNT+1
  1. .. S OK=1
  1. .. S RESULT="405^ADMIT"
  1. . I FMT=3 D Q
  1. .. I $D(^TMP("ORWGRPC TEMP",$J,"ADMIT")) Q
  1. .. S ^TMP("ORWGRPC TEMP",$J,"ADMIT")=""
  1. .. S CNT=CNT+1
  1. .. S OK=1
  1. .. S RESULT="405^ADMIT^^ADMIT^^"_DATE
  1. . I FMT=0 D Q
  1. .. S ^TMP("ORWGRPC TEMP",$J,"ADMIT")=""
  1. .. S CNT=CNT+1
  1. .. S OK=1
  1. .. S RESULT="405^ADMIT^ADMIT"
  1. I OK D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
  1. K ^TMP("ORWGRPC TEMP",$J)
  1. Q
  1. ;
  1. SURGERY(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
  1. N CASE,DATE,PROC,RESULT,RESULTS,SURG,SURGPROC K SURG,SURGPROC
  1. D SURG^ORWGAPIA(.SURG,DFN)
  1. K SURG(0),SURG(1)
  1. I FMT=6 D
  1. . S CASE=0
  1. . F S CASE=$O(SURG(CASE)) Q:CASE<1 D
  1. .. S RESULTS=SURG(CASE)
  1. .. S PROC=$P(RESULTS,U,3)
  1. .. I '$L(PROC) Q
  1. .. S DATE=$P(RESULTS,U,5)
  1. .. I DATE>NEWEST Q
  1. .. I DATE<OLDEST Q
  1. .. I $D(SURGPROC(PROC)) Q
  1. .. S SURGPROC(PROC)=""
  1. .. S CNT=CNT+1
  1. .. S RESULT=130_U_PROC
  1. .. D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
  1. I FMT'=6 D
  1. . S CASE=0
  1. . F S CASE=$O(SURG(CASE)) Q:CASE<1 D
  1. .. S RESULTS=SURG(CASE)
  1. .. S PROC=$P(RESULTS,U,3)
  1. .. I '$L(PROC) Q
  1. .. S SURGPROC(PROC)=RESULTS
  1. . K SURG S PROC=""
  1. . F S PROC=$O(SURGPROC(PROC)) Q:PROC="" D
  1. .. S CNT=CNT+1
  1. .. I FMT=3 S RESULT=130_U_PROC_"^^"_PROC_"^^"_$P(SURGPROC(PROC),U,5)
  1. .. I FMT=0 S RESULT=130_U_PROC_U_PROC
  1. .. D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
  1. Q
  1. ;
  1. VISITS(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
  1. N DATE,DATE2,ITEM,NODE,NUM,OK,RESULT
  1. K ^TMP("ORWGRPC TEMP",$J)
  1. I FMT=6 D
  1. . S DATE=0
  1. . F S DATE=$O(^AUPNVSIT("AET",DFN,DATE)) Q:DATE<1 Q:DATE>NEWEST D
  1. .. S ITEM=""
  1. .. F S ITEM=$O(^AUPNVSIT("AET",DFN,DATE,ITEM)) Q:ITEM="" D
  1. ... S NODE=""
  1. ... F S NODE=$O(^AUPNVSIT("AET",DFN,DATE,ITEM,NODE)) Q:NODE="" D
  1. .... S NUM=0
  1. .... F S NUM=$O(^AUPNVSIT("AET",DFN,DATE,ITEM,NODE,NUM)) Q:NUM="" D
  1. ..... S DATE2=+$P($G(^AUPNVSIT(NUM,0)),U,18)
  1. ..... I 'DATE2 S DATE2=DATE+.01
  1. ..... I +$E($P(DATE2,".",2),1,2)>24 S DATE2=(DATE\1)+.2359
  1. ..... S ^TMP("ORWGRPC TEMP",$J,ITEM,DATE)=DATE2
  1. . S ITEM=0
  1. . F S ITEM=$O(^TMP("ORWGRPC TEMP",$J,ITEM)) Q:ITEM<1 D
  1. .. S OK=0
  1. .. S DATE=0
  1. .. F S DATE=$O(^TMP("ORWGRPC TEMP",$J,ITEM,DATE)) Q:DATE<1 Q:DATE>NEWEST D Q:OK
  1. ... S DATE2=$G(^TMP("ORWGRPC TEMP",$J,ITEM,DATE))
  1. ... I DATE2<OLDEST Q
  1. ... S CNT=CNT+1
  1. ... S OK=1
  1. ... S RESULT="9000010^"_ITEM
  1. ... D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
  1. I FMT'=6 D
  1. . S DATE=0
  1. . F S DATE=$O(^AUPNVSIT("AET",DFN,DATE)) Q:DATE<1 D
  1. .. S ITEM=0
  1. .. F S ITEM=$O(^AUPNVSIT("AET",DFN,DATE,ITEM)) Q:ITEM<1 D
  1. ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
  1. ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
  1. ... S CNT=CNT+1
  1. ... I FMT=3 S RESULT="9000010^"_ITEM_"^^"_$$EVALUE^ORWGAPIU(ITEM,9000010,.22)_"^^"_DATE
  1. ... I FMT=0 S RESULT="9000010^"_ITEM_U_$$EVALUE^ORWGAPIU(ITEM,9000010,.22)
  1. ... D SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
  1. K ^TMP("ORWGRPC TEMP",$J)
  1. Q
  1. ;