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