- 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 Feb 19, 2025@00:02:50 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 ;