ORWGAPI6 ; SLC/STAFF - Graph API Items, non-indexed ;12/21/05 08:16
;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
;
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^ORWGAPIW(.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^ORWGAPIW(.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^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
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^ORWGAPIW(.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^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
K ^TMP("ORWGRPC TEMP",$J)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWGAPI6 3579 printed Dec 13, 2024@02:36:16 Page 2
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
+2 ;
ADMITS(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
+1 NEW DATE,DATE2,DISCH,LINE,LST,NUM,OK,RESULT
KILL LST
+2 KILL ^TMP("ORWGRPC TEMP",$JOB)
+3 DO ADMITLST^ORWPT(.LST,DFN)
+4 SET OK=0
+5 SET NUM=0
+6 FOR
SET NUM=$ORDER(LST(NUM))
if NUM<1
QUIT
Begin DoDot:1
+7 SET LINE=LST(NUM)
+8 SET DATE=$PIECE(LINE,U)
+9 SET DISCH=$PIECE(LINE,U,5)
+10 SET DATE2=$$DISCH^ORWGAPIA(DISCH)
+11 IF DATE2=""
SET DATE2=DATE2\1
+12 IF FMT=6
Begin DoDot:2
+13 IF DATE>NEWEST
QUIT
+14 IF DATE2>0
IF DATE2<OLDEST
QUIT
+15 IF $DATA(^TMP("ORWGRPC TEMP",$JOB,"ADMIT"))
QUIT
+16 SET ^TMP("ORWGRPC TEMP",$JOB,"ADMIT")=""
+17 SET CNT=CNT+1
+18 SET OK=1
+19 SET RESULT="405^ADMIT"
End DoDot:2
QUIT
+20 IF FMT=3
Begin DoDot:2
+21 IF $DATA(^TMP("ORWGRPC TEMP",$JOB,"ADMIT"))
QUIT
+22 SET ^TMP("ORWGRPC TEMP",$JOB,"ADMIT")=""
+23 SET CNT=CNT+1
+24 SET OK=1
+25 SET RESULT="405^ADMIT^^ADMIT^^"_DATE
End DoDot:2
QUIT
+26 IF FMT=0
Begin DoDot:2
+27 SET ^TMP("ORWGRPC TEMP",$JOB,"ADMIT")=""
+28 SET CNT=CNT+1
+29 SET OK=1
+30 SET RESULT="405^ADMIT^ADMIT"
End DoDot:2
QUIT
End DoDot:1
if OK
QUIT
+31 IF OK
DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
+32 KILL ^TMP("ORWGRPC TEMP",$JOB)
+33 QUIT
+34 ;
SURGERY(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
+1 NEW CASE,DATE,PROC,RESULT,RESULTS,SURG,SURGPROC
KILL SURG,SURGPROC
+2 DO SURG^ORWGAPIA(.SURG,DFN)
+3 KILL SURG(0),SURG(1)
+4 IF FMT=6
Begin DoDot:1
+5 SET CASE=0
+6 FOR
SET CASE=$ORDER(SURG(CASE))
if CASE<1
QUIT
Begin DoDot:2
+7 SET RESULTS=SURG(CASE)
+8 SET PROC=$PIECE(RESULTS,U,3)
+9 IF '$LENGTH(PROC)
QUIT
+10 SET DATE=$PIECE(RESULTS,U,5)
+11 IF DATE>NEWEST
QUIT
+12 IF DATE<OLDEST
QUIT
+13 IF $DATA(SURGPROC(PROC))
QUIT
+14 SET SURGPROC(PROC)=""
+15 SET CNT=CNT+1
+16 SET RESULT=130_U_PROC
+17 DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
End DoDot:2
End DoDot:1
+18 IF FMT'=6
Begin DoDot:1
+19 SET CASE=0
+20 FOR
SET CASE=$ORDER(SURG(CASE))
if CASE<1
QUIT
Begin DoDot:2
+21 SET RESULTS=SURG(CASE)
+22 SET PROC=$PIECE(RESULTS,U,3)
+23 IF '$LENGTH(PROC)
QUIT
+24 SET SURGPROC(PROC)=RESULTS
End DoDot:2
+25 KILL SURG
SET PROC=""
+26 FOR
SET PROC=$ORDER(SURGPROC(PROC))
if PROC=""
QUIT
Begin DoDot:2
+27 SET CNT=CNT+1
+28 IF FMT=3
SET RESULT=130_U_PROC_"^^"_PROC_"^^"_$PIECE(SURGPROC(PROC),U,5)
+29 IF FMT=0
SET RESULT=130_U_PROC_U_PROC
+30 DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
End DoDot:2
End DoDot:1
+31 QUIT
+32 ;
VISITS(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
+1 NEW DATE,DATE2,ITEM,NODE,NUM,OK,RESULT
+2 KILL ^TMP("ORWGRPC TEMP",$JOB)
+3 IF FMT=6
Begin DoDot:1
+4 SET DATE=0
+5 FOR
SET DATE=$ORDER(^AUPNVSIT("AET",DFN,DATE))
if DATE<1
QUIT
if DATE>NEWEST
QUIT
Begin DoDot:2
+6 SET ITEM=""
+7 FOR
SET ITEM=$ORDER(^AUPNVSIT("AET",DFN,DATE,ITEM))
if ITEM=""
QUIT
Begin DoDot:3
+8 SET NODE=""
+9 FOR
SET NODE=$ORDER(^AUPNVSIT("AET",DFN,DATE,ITEM,NODE))
if NODE=""
QUIT
Begin DoDot:4
+10 SET NUM=0
+11 FOR
SET NUM=$ORDER(^AUPNVSIT("AET",DFN,DATE,ITEM,NODE,NUM))
if NUM=""
QUIT
Begin DoDot:5
+12 SET DATE2=+$PIECE($GET(^AUPNVSIT(NUM,0)),U,18)
+13 IF 'DATE2
SET DATE2=DATE+.01
+14 IF +$EXTRACT($PIECE(DATE2,".",2),1,2)>24
SET DATE2=(DATE\1)+.2359
+15 SET ^TMP("ORWGRPC TEMP",$JOB,ITEM,DATE)=DATE2
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+16 SET ITEM=0
+17 FOR
SET ITEM=$ORDER(^TMP("ORWGRPC TEMP",$JOB,ITEM))
if ITEM<1
QUIT
Begin DoDot:2
+18 SET OK=0
+19 SET DATE=0
+20 FOR
SET DATE=$ORDER(^TMP("ORWGRPC TEMP",$JOB,ITEM,DATE))
if DATE<1
QUIT
if DATE>NEWEST
QUIT
Begin DoDot:3
+21 SET DATE2=$GET(^TMP("ORWGRPC TEMP",$JOB,ITEM,DATE))
+22 IF DATE2<OLDEST
QUIT
+23 SET CNT=CNT+1
+24 SET OK=1
+25 SET RESULT="9000010^"_ITEM
+26 DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
End DoDot:3
if OK
QUIT
End DoDot:2
End DoDot:1
+27 IF FMT'=6
Begin DoDot:1
+28 SET DATE=0
+29 FOR
SET DATE=$ORDER(^AUPNVSIT("AET",DFN,DATE))
if DATE<1
QUIT
Begin DoDot:2
+30 SET ITEM=0
+31 FOR
SET ITEM=$ORDER(^AUPNVSIT("AET",DFN,DATE,ITEM))
if ITEM<1
QUIT
Begin DoDot:3
+32 IF $DATA(^TMP("ORWGRPC TEMP",$JOB,ITEM))
QUIT
+33 SET ^TMP("ORWGRPC TEMP",$JOB,ITEM)=""
+34 SET CNT=CNT+1
+35 IF FMT=3
SET RESULT="9000010^"_ITEM_"^^"_$$EVALUE^ORWGAPIU(ITEM,9000010,.22)_"^^"_DATE
+36 IF FMT=0
SET RESULT="9000010^"_ITEM_U_$$EVALUE^ORWGAPIU(ITEM,9000010,.22)
+37 DO SETUP^ORWGAPIW(.ITEMS,RESULT,TMP,.CNT)
End DoDot:3
End DoDot:2
End DoDot:1
+38 KILL ^TMP("ORWGRPC TEMP",$JOB)
+39 QUIT
+40 ;
