- ORWGAPI4 ; SLC/STAFF - Graph Data, indexed ;8/21/06 07:52
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,260,243**;Dec 17, 1997;Build 242
- ;
- EDU(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
- S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
- F S DATE=$O(^PXRMINDX(9000010.16,"PI",DFN,ITEM,DATE)) Q:DATE="" D
- . I DATE>START Q
- . I DATE<BACKTO Q
- . S NODE=""
- . F S NODE=$O(^PXRMINDX(9000010.16,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
- .. D EDU^ORWGAPIA(NODE,.VALUE,.VALUES)
- .. S VALUE=VALUE("VALUE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.16,.06)_U_VALUES ;*****************************
- .. S RESULT=9000010.16_U_ITEM_U_DATE_"^^" ;_VALUE
- .. S RESULT=9000010.16_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
- .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- Q
- ;
- EXAM(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
- S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
- F S DATE=$O(^PXRMINDX(9000010.13,"PI",DFN,ITEM,DATE)) Q:DATE="" D
- . I DATE>START Q
- . I DATE<BACKTO Q
- . S NODE=""
- . F S NODE=$O(^PXRMINDX(9000010.13,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
- .. D EXAM^ORWGAPIA(NODE,.VALUE,.VALUES)
- .. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.13,.04)_U_VALUES ;*****************************
- .. S RESULT=9000010.13_U_ITEM_U_DATE_U_DATE2_U_VALUE
- .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- Q
- ;
- HF(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
- S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
- F S DATE=$O(^PXRMINDX(9000010.23,"PI",DFN,ITEM,DATE)) Q:DATE="" D
- . I DATE>START Q
- . I DATE<BACKTO Q
- . S NODE=""
- . F S NODE=$O(^PXRMINDX(9000010.23,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
- .. D HF^ORWGAPIA(NODE,.VALUE,.VALUES)
- .. S VALUE=VALUE("VALUE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.23,.04)_U_VALUES ;*****************************
- .. S RESULT=9000010.23_U_ITEM_U_DATE_U_DATE2_U_VALUE
- .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- Q
- ;
- IMM(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
- S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
- F S DATE=$O(^PXRMINDX(9000010.11,"PI",DFN,ITEM,DATE)) Q:DATE="" D
- . I DATE>START Q
- . I DATE<BACKTO Q
- . S NODE=""
- . F S NODE=$O(^PXRMINDX(9000010.11,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
- .. D IMM^ORWGAPIA(NODE,.VALUE,.VALUES)
- .. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.11,.04)_U_VALUES ;*****************************
- .. S CNT=CNT+1
- .. S RESULT=9000010.11_U_ITEM_U_DATE_U_DATE2_U_VALUE
- .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- Q
- ;
- MH(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
- S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
- F S DATE=$O(^PXRMINDX(601.2,"PI",DFN,ITEM,DATE)) Q:DATE="" D
- . I DATE>START Q
- . I DATE<BACKTO Q
- . S NODE=""
- . F S NODE=$O(^PXRMINDX(601.2,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
- .. D MH^ORWGAPIA(.VALUE,NODE,.VALUES) S VALUE=$P($G(VALUE(2)),U,2,3)_U_VALUES ;*****************************
- .. S RESULT=601.2_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
- .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- Q
- ;
- OP(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- N DATE,DATE2,NODE,NUM,RESULT,VALUE,VALUES K VALUE
- S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO),VALUES=""
- S NUM=""
- F S NUM=$O(^PXRMINDX(45,"ICD0","PNI",DFN,NUM)) Q:NUM="" D
- . S DATE=""
- . F S DATE=$O(^PXRMINDX(45,"ICD0","PNI",DFN,NUM,ITEM,DATE)) Q:DATE="" D
- .. I DATE>START Q
- .. I DATE<BACKTO Q
- .. S NODE=""
- .. F S NODE=$O(^PXRMINDX(45,"ICD0","PNI",DFN,NUM,ITEM,DATE,NODE)) Q:NODE="" D
- ... I '$L($G(^DGPT(+NODE,0))) Q ; ****** remove this when PTF patch is released **********
- ... D PTF^ORWGAPIA(NODE,.VALUE,.VALUES) S VALUE=$G(VALUE("DISCHARGE STATUS"))_U_VALUES ;*****************************
- ... S RESULT=45_"OP"_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
- ... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- Q
- ;
- POV(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- N DATE,DATE2,NODE,RESULT,TYPE,VALUE,VALUES K VALUE
- S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
- S TYPE=""
- F S TYPE=$O(^PXRMINDX(9000010.07,"PPI",DFN,TYPE)) Q:TYPE="" D
- . S DATE=""
- . F S DATE=$O(^PXRMINDX(9000010.07,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE="" D
- .. I DATE>START Q
- .. I DATE<BACKTO Q
- .. S NODE=""
- .. F S NODE=$O(^PXRMINDX(9000010.07,"PPI",DFN,TYPE,ITEM,DATE,NODE)) Q:NODE="" D
- ... D POV^ORWGAPIA(NODE,.VALUE,.VALUES)
- ... S VALUE=VALUE("CLINICAL TERM"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.07,.15)_U_VALUES ;*****************************
- ... S CNT=CNT+1
- ... S RESULT=9000010.07_U_ITEM_U_DATE_U_DATE2_U_VALUE
- ... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- Q
- ;
- PROB(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- N DATE,DATE2,DTONSET,DTRESOLV,ICD9,NODE,PRIORITY,PROB,PROBDX,PSTATUS,RESULT,STATUS,VALUE
- K ^TMP("ORWGRPC TEMP",$J)
- S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
- S STATUS=""
- F S STATUS=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS)) Q:STATUS="" D
- . S PRIORITY=""
- . F S PRIORITY=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY="" D
- .. S DATE=""
- .. F S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE)) Q:DATE="" D
- ... I DATE>START Q
- ... I DATE<BACKTO Q
- ... S NODE=""
- ... F S NODE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,NODE)) Q:NODE="" D
- .... S ^TMP("ORWGRPC TEMP",$J,ITEM,DATE,NODE)=""
- S ICD9=""
- F S ICD9=$O(^TMP("ORWGRPC TEMP",$J,ICD9)) Q:ICD9="" D
- . S DATE=""
- . F S DATE=$O(^TMP("ORWGRPC TEMP",$J,ICD9,DATE)) Q:DATE="" D
- .. S NODE=""
- .. F S NODE=$O(^TMP("ORWGRPC TEMP",$J,ICD9,DATE,NODE)) Q:NODE="" D
- ... D PROB^ORWGAPIA(.PROB,.PSTATUS,.PROBDX,.DTONSET,.DTRESOLV,NODE)
- ... S RESULT=9000011_U_ITEM_U_DTONSET_U_DATE2_U_$$EXT^ORWGAPIX(PSTATUS,9000011,.12)
- ... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- K ^TMP("ORWGRPC TEMP",$J)
- Q
- ;
- PROBX(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- D PROBX4^ORWGAPID(.DATA,ITEM,START,DFN,.CNT,.TMP)
- Q
- ;
- PROC(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- N DATE,DATE2,NODE,RESULT,TYPE,VALUE,VALUES K VALUE
- S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
- S TYPE=""
- F S TYPE=$O(^PXRMINDX(9000010.18,"PPI",DFN,TYPE)) Q:TYPE="" D
- . S DATE=""
- . F S DATE=$O(^PXRMINDX(9000010.18,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE="" D
- .. I DATE>START Q
- .. I DATE<BACKTO Q
- .. S NODE=""
- .. F S NODE=$O(^PXRMINDX(9000010.18,"PPI",DFN,TYPE,ITEM,DATE,NODE)) Q:NODE="" D
- ... D CPT^ORWGAPIA(NODE,.VALUE,.VALUES)
- ... S VALUE=VALUE("PRINCIPAL PROCEDURE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.18,.07)_U_VALUES ;*****************************
- ... S RESULT=9000010.18_U_ITEM_U_DATE_U_DATE2_U_VALUE
- ... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- Q
- ;
- SKIN(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
- S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
- F S DATE=$O(^PXRMINDX(9000010.12,"PI",DFN,ITEM,DATE)) Q:DATE="" D
- . I DATE>START Q
- . I DATE<BACKTO Q
- . S NODE=""
- . F S NODE=$O(^PXRMINDX(9000010.12,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
- .. D SKIN^ORWGAPIA(NODE,.VALUE,.VALUES)
- .. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.12,.04)_U_VALUES ;*****************************
- .. S CNT=CNT+1
- .. S RESULT=9000010.12_U_ITEM_U_DATE_U_DATE2_U_VALUE
- .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- Q
- ;
- VITAL(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- I ITEM=99999 D BMIDATA^ORWGAPIX(.DATA,ITEM,START,DFN,.CNT,TMP) Q
- N DATE,DATE2,NODE,RESULT,VALUE,VALUES K VALUE
- S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
- F S DATE=$O(^PXRMINDX(120.5,"PI",DFN,ITEM,DATE)) Q:DATE="" D
- . I DATE>START Q
- . I DATE<BACKTO Q
- . S NODE=""
- . F S NODE=$O(^PXRMINDX(120.5,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
- .. D VITAL^ORWGAPIA(.VALUE,NODE,.VALUES) S VALUE=$P($G(VALUE(7)),U)
- .. I $P($G(VALUE(3)),U,2)="PAIN",VALUE=99 S VALUE="(99)"
- .. S RESULT=120.5_U_ITEM_U_DATE_U_DATE2_U_VALUE_U_U_VALUES ;*****************************
- .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWGAPI4 8247 printed Feb 19, 2025@00:02:46 Page 2
- ORWGAPI4 ; SLC/STAFF - Graph Data, indexed ;8/21/06 07:52
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,260,243**;Dec 17, 1997;Build 242
- +2 ;
- EDU(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- +1 NEW DATE,DATE2,NODE,RESULT,VALUE,VALUES
- KILL VALUE
- +2 SET DATE=""
- SET DATE2=""
- SET CNT=$GET(CNT)
- SET BACKTO=+$GET(BACKTO)
- +3 FOR
- SET DATE=$ORDER(^PXRMINDX(9000010.16,"PI",DFN,ITEM,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(^PXRMINDX(9000010.16,"PI",DFN,ITEM,DATE,NODE))
- if NODE=""
- QUIT
- Begin DoDot:2
- +8 DO EDU^ORWGAPIA(NODE,.VALUE,.VALUES)
- +9 ;*****************************
- SET VALUE=VALUE("VALUE")
- SET VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.16,.06)_U_VALUES
- +10 ;_VALUE
- SET RESULT=9000010.16_U_ITEM_U_DATE_"^^"
- +11 ;_VALUE
- SET RESULT=9000010.16_U_ITEM_U_DATE_U_DATE2_U
- +12 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- End DoDot:2
- End DoDot:1
- +13 QUIT
- +14 ;
- EXAM(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- +1 NEW DATE,DATE2,NODE,RESULT,VALUE,VALUES
- KILL VALUE
- +2 SET DATE=""
- SET DATE2=""
- SET CNT=$GET(CNT)
- SET BACKTO=+$GET(BACKTO)
- +3 FOR
- SET DATE=$ORDER(^PXRMINDX(9000010.13,"PI",DFN,ITEM,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(^PXRMINDX(9000010.13,"PI",DFN,ITEM,DATE,NODE))
- if NODE=""
- QUIT
- Begin DoDot:2
- +8 DO EXAM^ORWGAPIA(NODE,.VALUE,.VALUES)
- +9 ;*****************************
- SET VALUE=$GET(VALUE("VALUE"))
- SET VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.13,.04)_U_VALUES
- +10 SET RESULT=9000010.13_U_ITEM_U_DATE_U_DATE2_U_VALUE
- +11 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- End DoDot:2
- End DoDot:1
- +12 QUIT
- +13 ;
- HF(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- +1 NEW DATE,DATE2,NODE,RESULT,VALUE,VALUES
- KILL VALUE
- +2 SET DATE=""
- SET DATE2=""
- SET CNT=$GET(CNT)
- SET BACKTO=+$GET(BACKTO)
- +3 FOR
- SET DATE=$ORDER(^PXRMINDX(9000010.23,"PI",DFN,ITEM,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(^PXRMINDX(9000010.23,"PI",DFN,ITEM,DATE,NODE))
- if NODE=""
- QUIT
- Begin DoDot:2
- +8 DO HF^ORWGAPIA(NODE,.VALUE,.VALUES)
- +9 ;*****************************
- SET VALUE=VALUE("VALUE")
- SET VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.23,.04)_U_VALUES
- +10 SET RESULT=9000010.23_U_ITEM_U_DATE_U_DATE2_U_VALUE
- +11 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- End DoDot:2
- End DoDot:1
- +12 QUIT
- +13 ;
- IMM(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- +1 NEW DATE,DATE2,NODE,RESULT,VALUE,VALUES
- KILL VALUE
- +2 SET DATE=""
- SET DATE2=""
- SET CNT=$GET(CNT)
- SET BACKTO=+$GET(BACKTO)
- +3 FOR
- SET DATE=$ORDER(^PXRMINDX(9000010.11,"PI",DFN,ITEM,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(^PXRMINDX(9000010.11,"PI",DFN,ITEM,DATE,NODE))
- if NODE=""
- QUIT
- Begin DoDot:2
- +8 DO IMM^ORWGAPIA(NODE,.VALUE,.VALUES)
- +9 ;*****************************
- SET VALUE=$GET(VALUE("VALUE"))
- SET VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.11,.04)_U_VALUES
- +10 SET CNT=CNT+1
- +11 SET RESULT=9000010.11_U_ITEM_U_DATE_U_DATE2_U_VALUE
- +12 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- End DoDot:2
- End DoDot:1
- +13 QUIT
- +14 ;
- MH(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- +1 NEW DATE,DATE2,NODE,RESULT,VALUE,VALUES
- KILL VALUE
- +2 SET DATE=""
- SET DATE2=""
- SET CNT=$GET(CNT)
- SET BACKTO=+$GET(BACKTO)
- +3 FOR
- SET DATE=$ORDER(^PXRMINDX(601.2,"PI",DFN,ITEM,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(^PXRMINDX(601.2,"PI",DFN,ITEM,DATE,NODE))
- if NODE=""
- QUIT
- Begin DoDot:2
- +8 ;*****************************
- DO MH^ORWGAPIA(.VALUE,NODE,.VALUES)
- SET VALUE=$PIECE($GET(VALUE(2)),U,2,3)_U_VALUES
- +9 ;_VALUE
- SET RESULT=601.2_U_ITEM_U_DATE_U_DATE2_U
- +10 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- End DoDot:2
- End DoDot:1
- +11 QUIT
- +12 ;
- OP(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- +1 NEW DATE,DATE2,NODE,NUM,RESULT,VALUE,VALUES
- KILL VALUE
- +2 SET DATE2=""
- SET CNT=$GET(CNT)
- SET BACKTO=+$GET(BACKTO)
- SET VALUES=""
- +3 SET NUM=""
- +4 FOR
- SET NUM=$ORDER(^PXRMINDX(45,"ICD0","PNI",DFN,NUM))
- if NUM=""
- QUIT
- Begin DoDot:1
- +5 SET DATE=""
- +6 FOR
- SET DATE=$ORDER(^PXRMINDX(45,"ICD0","PNI",DFN,NUM,ITEM,DATE))
- if DATE=""
- QUIT
- Begin DoDot:2
- +7 IF DATE>START
- QUIT
- +8 IF DATE<BACKTO
- QUIT
- +9 SET NODE=""
- +10 FOR
- SET NODE=$ORDER(^PXRMINDX(45,"ICD0","PNI",DFN,NUM,ITEM,DATE,NODE))
- if NODE=""
- QUIT
- Begin DoDot:3
- +11 ; ****** remove this when PTF patch is released **********
- IF '$LENGTH($GET(^DGPT(+NODE,0)))
- QUIT
- +12 ;*****************************
- DO PTF^ORWGAPIA(NODE,.VALUE,.VALUES)
- SET VALUE=$GET(VALUE("DISCHARGE STATUS"))_U_VALUES
- +13 ;_VALUE
- SET RESULT=45_"OP"_U_ITEM_U_DATE_U_DATE2_U
- +14 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +15 QUIT
- +16 ;
- POV(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- +1 NEW DATE,DATE2,NODE,RESULT,TYPE,VALUE,VALUES
- KILL VALUE
- +2 SET DATE2=""
- SET CNT=$GET(CNT)
- SET BACKTO=+$GET(BACKTO)
- +3 SET TYPE=""
- +4 FOR
- SET TYPE=$ORDER(^PXRMINDX(9000010.07,"PPI",DFN,TYPE))
- if TYPE=""
- QUIT
- Begin DoDot:1
- +5 SET DATE=""
- +6 FOR
- SET DATE=$ORDER(^PXRMINDX(9000010.07,"PPI",DFN,TYPE,ITEM,DATE))
- if DATE=""
- QUIT
- Begin DoDot:2
- +7 IF DATE>START
- QUIT
- +8 IF DATE<BACKTO
- QUIT
- +9 SET NODE=""
- +10 FOR
- SET NODE=$ORDER(^PXRMINDX(9000010.07,"PPI",DFN,TYPE,ITEM,DATE,NODE))
- if NODE=""
- QUIT
- Begin DoDot:3
- +11 DO POV^ORWGAPIA(NODE,.VALUE,.VALUES)
- +12 ;*****************************
- SET VALUE=VALUE("CLINICAL TERM")
- SET VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.07,.15)_U_VALUES
- +13 SET CNT=CNT+1
- +14 SET RESULT=9000010.07_U_ITEM_U_DATE_U_DATE2_U_VALUE
- +15 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +16 QUIT
- +17 ;
- PROB(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- +1 NEW DATE,DATE2,DTONSET,DTRESOLV,ICD9,NODE,PRIORITY,PROB,PROBDX,PSTATUS,RESULT,STATUS,VALUE
- +2 KILL ^TMP("ORWGRPC TEMP",$JOB)
- +3 SET DATE2=""
- SET CNT=$GET(CNT)
- SET BACKTO=+$GET(BACKTO)
- +4 SET STATUS=""
- +5 FOR
- SET STATUS=$ORDER(^PXRMINDX(9000011,"PSPI",DFN,STATUS))
- if STATUS=""
- QUIT
- Begin DoDot:1
- +6 SET PRIORITY=""
- +7 FOR
- SET PRIORITY=$ORDER(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY))
- if PRIORITY=""
- QUIT
- Begin DoDot:2
- +8 SET DATE=""
- +9 FOR
- SET DATE=$ORDER(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE))
- if DATE=""
- QUIT
- Begin DoDot:3
- +10 IF DATE>START
- QUIT
- +11 IF DATE<BACKTO
- QUIT
- +12 SET NODE=""
- +13 FOR
- SET NODE=$ORDER(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,NODE))
- if NODE=""
- QUIT
- Begin DoDot:4
- +14 SET ^TMP("ORWGRPC TEMP",$JOB,ITEM,DATE,NODE)=""
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +15 SET ICD9=""
- +16 FOR
- SET ICD9=$ORDER(^TMP("ORWGRPC TEMP",$JOB,ICD9))
- if ICD9=""
- QUIT
- Begin DoDot:1
- +17 SET DATE=""
- +18 FOR
- SET DATE=$ORDER(^TMP("ORWGRPC TEMP",$JOB,ICD9,DATE))
- if DATE=""
- QUIT
- Begin DoDot:2
- +19 SET NODE=""
- +20 FOR
- SET NODE=$ORDER(^TMP("ORWGRPC TEMP",$JOB,ICD9,DATE,NODE))
- if NODE=""
- QUIT
- Begin DoDot:3
- +21 DO PROB^ORWGAPIA(.PROB,.PSTATUS,.PROBDX,.DTONSET,.DTRESOLV,NODE)
- +22 SET RESULT=9000011_U_ITEM_U_DTONSET_U_DATE2_U_$$EXT^ORWGAPIX(PSTATUS,9000011,.12)
- +23 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +24 KILL ^TMP("ORWGRPC TEMP",$JOB)
- +25 QUIT
- +26 ;
- PROBX(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- +1 DO PROBX4^ORWGAPID(.DATA,ITEM,START,DFN,.CNT,.TMP)
- +2 QUIT
- +3 ;
- PROC(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- +1 NEW DATE,DATE2,NODE,RESULT,TYPE,VALUE,VALUES
- KILL VALUE
- +2 SET DATE2=""
- SET CNT=$GET(CNT)
- SET BACKTO=+$GET(BACKTO)
- +3 SET TYPE=""
- +4 FOR
- SET TYPE=$ORDER(^PXRMINDX(9000010.18,"PPI",DFN,TYPE))
- if TYPE=""
- QUIT
- Begin DoDot:1
- +5 SET DATE=""
- +6 FOR
- SET DATE=$ORDER(^PXRMINDX(9000010.18,"PPI",DFN,TYPE,ITEM,DATE))
- if DATE=""
- QUIT
- Begin DoDot:2
- +7 IF DATE>START
- QUIT
- +8 IF DATE<BACKTO
- QUIT
- +9 SET NODE=""
- +10 FOR
- SET NODE=$ORDER(^PXRMINDX(9000010.18,"PPI",DFN,TYPE,ITEM,DATE,NODE))
- if NODE=""
- QUIT
- Begin DoDot:3
- +11 DO CPT^ORWGAPIA(NODE,.VALUE,.VALUES)
- +12 ;*****************************
- SET VALUE=VALUE("PRINCIPAL PROCEDURE")
- SET VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.18,.07)_U_VALUES
- +13 SET RESULT=9000010.18_U_ITEM_U_DATE_U_DATE2_U_VALUE
- +14 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +15 QUIT
- +16 ;
- SKIN(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- +1 NEW DATE,DATE2,NODE,RESULT,VALUE,VALUES
- KILL VALUE
- +2 SET DATE=""
- SET DATE2=""
- SET CNT=$GET(CNT)
- SET BACKTO=+$GET(BACKTO)
- +3 FOR
- SET DATE=$ORDER(^PXRMINDX(9000010.12,"PI",DFN,ITEM,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(^PXRMINDX(9000010.12,"PI",DFN,ITEM,DATE,NODE))
- if NODE=""
- QUIT
- Begin DoDot:2
- +8 DO SKIN^ORWGAPIA(NODE,.VALUE,.VALUES)
- +9 ;*****************************
- SET VALUE=$GET(VALUE("VALUE"))
- SET VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.12,.04)_U_VALUES
- +10 SET CNT=CNT+1
- +11 SET RESULT=9000010.12_U_ITEM_U_DATE_U_DATE2_U_VALUE
- +12 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- End DoDot:2
- End DoDot:1
- +13 QUIT
- +14 ;
- VITAL(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- +1 IF ITEM=99999
- DO BMIDATA^ORWGAPIX(.DATA,ITEM,START,DFN,.CNT,TMP)
- QUIT
- +2 NEW DATE,DATE2,NODE,RESULT,VALUE,VALUES
- KILL VALUE
- +3 SET DATE=""
- SET DATE2=""
- SET CNT=$GET(CNT)
- SET BACKTO=+$GET(BACKTO)
- +4 FOR
- SET DATE=$ORDER(^PXRMINDX(120.5,"PI",DFN,ITEM,DATE))
- if DATE=""
- QUIT
- Begin DoDot:1
- +5 IF DATE>START
- QUIT
- +6 IF DATE<BACKTO
- QUIT
- +7 SET NODE=""
- +8 FOR
- SET NODE=$ORDER(^PXRMINDX(120.5,"PI",DFN,ITEM,DATE,NODE))
- if NODE=""
- QUIT
- Begin DoDot:2
- +9 DO VITAL^ORWGAPIA(.VALUE,NODE,.VALUES)
- SET VALUE=$PIECE($GET(VALUE(7)),U)
- +10 IF $PIECE($GET(VALUE(3)),U,2)="PAIN"
- IF VALUE=99
- SET VALUE="(99)"
- +11 ;*****************************
- SET RESULT=120.5_U_ITEM_U_DATE_U_DATE2_U_VALUE_U_U_VALUES
- +12 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- End DoDot:2
- End DoDot:1
- +13 QUIT
- +14 ;