ORWGAPI8 ; SLC/STAFF - Graph Data, non-index ;8/21/06 07:52
;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
;
ADMIT(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
N DATE,DATE2,DISCH,LINE,LST,NUM,RESULT,VALUE K LST
S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
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^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
Q
;
SURG(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
N CASE,DATE,DATE2,NUM,PROC,RESULT,RESULTS,SURG,SURGPROC,VALUE K SURG,SURGPROC
S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
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
.. I DATE<BACKTO Q
.. S VALUE=""
.. S RESULT=130_U_PROC_U_DATE_U_DATE2_U_VALUE
.. S CNT=CNT+1
.. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
Q
;
VISIT(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
N DATE,DATE2,NODE,NUM,RESULT,VALUE
S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
F S DATE=$O(^AUPNVSIT("AET",DFN,DATE)) Q:DATE="" D
. I DATE>START Q
. I DATE<BACKTO 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^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWGAPI8 2400 printed Oct 16, 2024@18:36:51 Page 2
ORWGAPI8 ; SLC/STAFF - Graph Data, non-index ;8/21/06 07:52
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
+2 ;
ADMIT(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
+1 NEW DATE,DATE2,DISCH,LINE,LST,NUM,RESULT,VALUE
KILL LST
+2 SET DATE=""
SET DATE2=""
SET CNT=$GET(CNT)
SET BACKTO=+$GET(BACKTO)
+3 SET ITEM=$GET(ITEM,"ADMIT")
+4 DO ADMITLST^ORWPT(.LST,DFN)
+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 IF DATE>START
QUIT
+10 SET DISCH=$PIECE(LINE,U,5)
+11 SET DATE2=$$DISCH^ORWGAPIA(DISCH)
+12 IF DATE2=""
Begin DoDot:2
+13 SET DATE2=$$FMADD^ORWGAPIX(DATE,$$LOS^ORWGAPIA(DISCH)+1)
+14 ; just make it today + 1
IF DATE2=-1
SET DATE2=$$FMADD^ORWGAPIX(DT,1)
+15 SET DATE2=DATE2\1
End DoDot:2
+16 SET VALUE=$PIECE(LINE,U,3)_" "_$PIECE(LINE,U,4)_U_$PIECE(LINE,U,5,6)
+17 SET CNT=CNT+1
+18 SET RESULT=405_U_ITEM_U_DATE_U_DATE2_U_VALUE
+19 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:1
+20 QUIT
+21 ;
SURG(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
+1 NEW CASE,DATE,DATE2,NUM,PROC,RESULT,RESULTS,SURG,SURGPROC,VALUE
KILL SURG,SURGPROC
+2 SET DATE2=""
SET CNT=$GET(CNT)
SET BACKTO=+$GET(BACKTO)
+3 DO SURG^ORWGAPIA(.SURG,DFN)
+4 KILL SURG(0),SURG(1)
+5 SET ITEM=$$UP^ORWGAPIX(ITEM)
+6 SET NUM=0
+7 SET CASE=0
+8 FOR
SET CASE=$ORDER(SURG(CASE))
if CASE<1
QUIT
Begin DoDot:1
+9 SET RESULTS=SURG(CASE)
+10 SET PROC=$PIECE(RESULTS,U,3)
+11 IF '$LENGTH(PROC)
QUIT
+12 SET PROC=$$UP^ORWGAPIX(PROC)
+13 IF PROC'=ITEM
QUIT
+14 SET NUM=NUM+1
+15 SET SURGPROC(PROC,NUM)=RESULTS
End DoDot:1
+16 KILL SURG
+17 SET PROC=""
+18 FOR
SET PROC=$ORDER(SURGPROC(PROC))
if PROC=""
QUIT
Begin DoDot:1
+19 SET NUM=0
+20 FOR
SET NUM=$ORDER(SURGPROC(PROC,NUM))
if NUM<1
QUIT
Begin DoDot:2
+21 SET RESULTS=SURGPROC(PROC,NUM)
+22 SET DATE=$PIECE(RESULTS,U,5)
+23 IF DATE>START
QUIT
+24 IF DATE<BACKTO
QUIT
+25 SET VALUE=""
+26 SET RESULT=130_U_PROC_U_DATE_U_DATE2_U_VALUE
+27 SET CNT=CNT+1
+28 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:2
End DoDot:1
+29 QUIT
+30 ;
VISIT(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
+1 NEW DATE,DATE2,NODE,NUM,RESULT,VALUE
+2 SET DATE=""
SET DATE2=""
SET CNT=$GET(CNT)
SET BACKTO=+$GET(BACKTO)
+3 FOR
SET DATE=$ORDER(^AUPNVSIT("AET",DFN,DATE))
if DATE=""
QUIT
Begin DoDot:1
+4 IF DATE>START
QUIT
+5 IF DATE<BACKTO
QUIT
+6 SET NODE=""
+7 FOR
SET NODE=$ORDER(^AUPNVSIT("AET",DFN,DATE,ITEM,NODE))
if NODE=""
QUIT
Begin DoDot:2
+8 SET NUM=0
+9 FOR
SET NUM=$ORDER(^AUPNVSIT("AET",DFN,DATE,ITEM,NODE,NUM))
if NUM=""
QUIT
Begin DoDot:3
+10 SET DATE2=+$PIECE($GET(^AUPNVSIT(NUM,0)),U,18)
+11 IF 'DATE2
SET DATE2=DATE+.01
+12 IF +$EXTRACT($PIECE(DATE2,".",2),1,2)>24
SET DATE2=(DATE\1)+.2359
+13 SET VALUE=""
+14 SET CNT=CNT+1
+15 SET RESULT=9000010_U_ITEM_U_DATE_U_DATE2_U_VALUE
+16 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
