- ORWGAPI3 ; SLC/STAFF - Graph Data ;07/28/09 11:34
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243,280**;Dec 17, 1997;Build 85
- ;
- ;
- ADVERSE(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- N ADVERSE,DATE,DATE2,NODE,RESULT,RXN,VALUE
- S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
- S ADVERSE=""
- S VALUE=ITEM_U_ITEM
- S NODE=""
- F S NODE=$O(^GMR(120.8,"B",DFN,NODE)) Q:NODE="" D
- . I '$D(^GMR(120.8,NODE,0)) Q
- . I $G(^GMR(120.8,NODE,"ER")) Q ; entered in error
- . I '$P(^GMR(120.8,NODE,0),U,12) Q ; signed
- . S DATE=+$P($G(^GMR(120.8,NODE,0)),U,4) I 'DATE Q
- . I DATE>START Q
- . I DATE<BACKTO Q
- . I ITEM'=$P(^GMR(120.8,NODE,0),U,2) Q
- . S RXN=0
- . F S RXN=$O(^GMR(120.8,NODE,10,"B",RXN)) Q:RXN<1 D
- .. S ADVERSE=ADVERSE_$$EVALUE^ORWGAPIU(RXN,120.8)_", "
- . I $L(ADVERSE)>0 S ADVERSE=$E(ADVERSE,1,$L(ADVERSE)-2)
- . S CNT=CNT+1
- . S RESULT=120.8_U_ITEM_U_DATE_U_DATE2_U_ADVERSE
- . D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- Q
- ;
- DX(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- N DATE,DATE2,NODE,NUM,RESULT,VALUE,VALUES K VALUE
- K ^TMP("ORWGRPC TEMP",$J)
- S DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
- S NUM=""
- F S NUM=$O(^PXRMINDX(45,"ICD9","PNI",DFN,NUM)) Q:NUM="" D
- . S DATE=""
- . F S DATE=$O(^PXRMINDX(45,"ICD9","PNI",DFN,NUM,ITEM,DATE)) Q:DATE="" D
- .. I DATE>START Q
- .. I DATE<BACKTO Q
- .. S NODE=""
- .. F S NODE=$O(^PXRMINDX(45,"ICD9","PNI",DFN,NUM,ITEM,DATE,NODE)) Q:NODE="" D
- ... I '$D(^TMP("ORWGRPC TEMP",$J,ITEM,DATE)) S ^TMP("ORWGRPC TEMP",$J,ITEM,DATE)=NODE_U_NUM
- S ITEM=""
- F S ITEM=$O(^TMP("ORWGRPC TEMP",$J,ITEM)) Q:ITEM="" D
- . S DATE=""
- . F S DATE=$O(^TMP("ORWGRPC TEMP",$J,ITEM,DATE)) Q:DATE="" D
- .. S NODE=$G(^TMP("ORWGRPC TEMP",$J,ITEM,DATE)) I '$L(NODE) Q
- .. S NUM=$P(NODE,U,2)
- .. S NODE=$P(NODE,U)
- .. I '$L($G(^DGPT(+NODE,0))) Q ; ****** remove this when PTF patch is released **********
- .. D PTF^ORWGAPIA(NODE,.VALUE,.VALUES) S VALUE=$$EXT^ORWGAPIX($G(VALUE("DISCHARGE STATUS")),45,6)
- .. I NUM="DXLS" S VALUE="(DXLS) "_VALUE_U_U_VALUES ;*****************************
- .. S RESULT=45_"DX"_U_ITEM_U_DATE_U_DATE2_U_" "_VALUE
- .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- K ^TMP("ORWGRPC TEMP",$J)
- Q
- ;
- LAB(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- N COMMENT,DATE,DATE2,NODE,RESULT,TYPE,VALUE K VALUE
- S DATE="",DATE2="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
- D
- . I $E(ITEM)="A" S TYPE="AP" Q
- . I $E(ITEM)="M" S TYPE="MI" Q
- . S TYPE="" Q
- F S DATE=$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE)) Q:DATE="" D
- . I DATE>START Q
- . I DATE<BACKTO Q
- . S NODE=""
- . F S NODE=$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
- .. K VALUE
- .. D LAB^ORWGAPIC(.VALUE,NODE,ITEM)
- .. I TYPE="AP" S RESULT="63AP^"_ITEM_U_DATE_U_DATE2 ;_U_$P(VALUE,U,2)
- .. I TYPE="MI" S RESULT="63MI^"_ITEM_U_DATE_U_DATE2_U_$P(VALUE,U,4)
- .. I TYPE="" D
- ... S COMMENT=""
- ... I $L($G(VALUE("COMMENTS",1))) S COMMENT=1
- ... S RESULT="63^"_ITEM_U_DATE_U_DATE2_U_$P(VALUE,U,3)_U_$P(VALUE,U,4)_U_$G(VALUE("SPECIMEN"))_U_COMMENT
- ... I $L($P(VALUE,U,7)) S $P(RESULT,U,10)=$P($P(VALUE,U,7),"!",2,3)_U_$P($P(VALUE,U,7),"!",7)
- .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- Q
- ;
- MED(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- D MED3^ORWGAPIE(.DATA,ITEM,START,DFN,.CNT,.TMP)
- Q
- ;
- NOTE(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- N DATE,DOC,DOCCLASS,DOCTYPE,DUM,IEN,RESULT,RESULTS,TITLE,VALUE K DUM
- K ^TMP("ORWGRPC TEMP",$J),^TMP("TIUR",$J)
- S CNT=$G(CNT),ITEM=$$UP^ORWGAPIX(ITEM),BACKTO=+$G(BACKTO)
- F DOCTYPE="P","D","C" D
- . S DOCCLASS=$$DOCCLASS^ORWGAPIA(DOCTYPE)
- . K ^TMP("TIUR",$J)
- . D TIU^ORWGAPIA(.DUM,DOCCLASS,5,DFN)
- . S DOC=0
- . F S DOC=$O(^TMP("TIUR",$J,DOC)) Q:DOC<1 D
- .. S RESULTS=^TMP("TIUR",$J,DOC)
- .. S IEN=+$P(RESULTS,U)
- .. S TITLE=$$UP^ORWGAPIX($P(RESULTS,U,2))
- .. I TITLE'=ITEM Q
- .. ; do not use admission date S DATE=$P($G(^AUPNVSIT(+$P($G(^TIU(8925,IEN,0)),U,3),0)),U)
- .. S DATE=$P(RESULTS,U,3)
- .. I DATE>START Q
- .. I DATE<BACKTO Q
- .. S VALUE=$P(RESULTS,U,7)
- .. S CNT=CNT+1
- .. S RESULT=8925_U_TITLE_U_DATE_"^^"_VALUE
- .. I $D(^TMP("ORWGRPC TEMP",$J,RESULT)) Q
- .. S ^TMP("ORWGRPC TEMP",$J,RESULT)=""
- .. D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- K ^TMP("ORWGRPC TEMP",$J),^TMP("TIUR",$J)
- Q
- ;
- ORDER(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- N DATE,DATE2,NODE,ORUPCHUK,RESULT,VALUE K ORUPCHUK
- S DATE="",CNT=$G(CNT),BACKTO=+$G(BACKTO)
- F S DATE=$O(^PXRMINDX(100,"PI",DFN,ITEM,DATE)) Q:DATE="" D
- . I DATE>START Q
- . I DATE<BACKTO Q
- . S DATE2=""
- . F S DATE2=$O(^PXRMINDX(100,"PI",DFN,ITEM,DATE,DATE2)) Q:DATE2="" D
- .. S NODE=""
- .. F S NODE=$O(^PXRMINDX(100,"PI",DFN,ITEM,DATE,DATE2,NODE)) Q:NODE="" D
- ... D EN^ORX8($P(NODE,";")) S VALUE=$P($G(ORUPCHUK("ORSTS")),U,2)
- ... S RESULT=100_U_ITEM_U_DATE_"^^"_VALUE
- ... D SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- Q
- ;
- RAD(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(70,"PI",DFN,ITEM,DATE)) Q:DATE="" D
- . I DATE>START Q
- . I DATE<BACKTO Q
- . S NODE=""
- . F S NODE=$O(^PXRMINDX(70,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
- .. D RAD^ORWGAPIA(NODE,.VALUE,.VALUES) S VALUE=$G(VALUE("PDX"))_"-"_$G(VALUE("EXAM STATUS"))_U_U_VALUES
- .. S RESULT=70_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[HORWGAPI3 5433 printed Feb 19, 2025@00:02:45 Page 2
- ORWGAPI3 ; SLC/STAFF - Graph Data ;07/28/09 11:34
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243,280**;Dec 17, 1997;Build 85
- +2 ;
- +3 ;
- ADVERSE(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- +1 NEW ADVERSE,DATE,DATE2,NODE,RESULT,RXN,VALUE
- +2 SET DATE=""
- SET DATE2=""
- SET CNT=$GET(CNT)
- SET BACKTO=+$GET(BACKTO)
- +3 SET ADVERSE=""
- +4 SET VALUE=ITEM_U_ITEM
- +5 SET NODE=""
- +6 FOR
- SET NODE=$ORDER(^GMR(120.8,"B",DFN,NODE))
- if NODE=""
- QUIT
- Begin DoDot:1
- +7 IF '$DATA(^GMR(120.8,NODE,0))
- QUIT
- +8 ; entered in error
- IF $GET(^GMR(120.8,NODE,"ER"))
- QUIT
- +9 ; signed
- IF '$PIECE(^GMR(120.8,NODE,0),U,12)
- QUIT
- +10 SET DATE=+$PIECE($GET(^GMR(120.8,NODE,0)),U,4)
- IF 'DATE
- QUIT
- +11 IF DATE>START
- QUIT
- +12 IF DATE<BACKTO
- QUIT
- +13 IF ITEM'=$PIECE(^GMR(120.8,NODE,0),U,2)
- QUIT
- +14 SET RXN=0
- +15 FOR
- SET RXN=$ORDER(^GMR(120.8,NODE,10,"B",RXN))
- if RXN<1
- QUIT
- Begin DoDot:2
- +16 SET ADVERSE=ADVERSE_$$EVALUE^ORWGAPIU(RXN,120.8)_", "
- End DoDot:2
- +17 IF $LENGTH(ADVERSE)>0
- SET ADVERSE=$EXTRACT(ADVERSE,1,$LENGTH(ADVERSE)-2)
- +18 SET CNT=CNT+1
- +19 SET RESULT=120.8_U_ITEM_U_DATE_U_DATE2_U_ADVERSE
- +20 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- End DoDot:1
- +21 QUIT
- +22 ;
- DX(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- +1 NEW DATE,DATE2,NODE,NUM,RESULT,VALUE,VALUES
- KILL VALUE
- +2 KILL ^TMP("ORWGRPC TEMP",$JOB)
- +3 SET DATE2=""
- SET CNT=$GET(CNT)
- SET BACKTO=+$GET(BACKTO)
- +4 SET NUM=""
- +5 FOR
- SET NUM=$ORDER(^PXRMINDX(45,"ICD9","PNI",DFN,NUM))
- if NUM=""
- QUIT
- Begin DoDot:1
- +6 SET DATE=""
- +7 FOR
- SET DATE=$ORDER(^PXRMINDX(45,"ICD9","PNI",DFN,NUM,ITEM,DATE))
- if DATE=""
- QUIT
- Begin DoDot:2
- +8 IF DATE>START
- QUIT
- +9 IF DATE<BACKTO
- QUIT
- +10 SET NODE=""
- +11 FOR
- SET NODE=$ORDER(^PXRMINDX(45,"ICD9","PNI",DFN,NUM,ITEM,DATE,NODE))
- if NODE=""
- QUIT
- Begin DoDot:3
- +12 IF '$DATA(^TMP("ORWGRPC TEMP",$JOB,ITEM,DATE))
- SET ^TMP("ORWGRPC TEMP",$JOB,ITEM,DATE)=NODE_U_NUM
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +13 SET ITEM=""
- +14 FOR
- SET ITEM=$ORDER(^TMP("ORWGRPC TEMP",$JOB,ITEM))
- if ITEM=""
- QUIT
- Begin DoDot:1
- +15 SET DATE=""
- +16 FOR
- SET DATE=$ORDER(^TMP("ORWGRPC TEMP",$JOB,ITEM,DATE))
- if DATE=""
- QUIT
- Begin DoDot:2
- +17 SET NODE=$GET(^TMP("ORWGRPC TEMP",$JOB,ITEM,DATE))
- IF '$LENGTH(NODE)
- QUIT
- +18 SET NUM=$PIECE(NODE,U,2)
- +19 SET NODE=$PIECE(NODE,U)
- +20 ; ****** remove this when PTF patch is released **********
- IF '$LENGTH($GET(^DGPT(+NODE,0)))
- QUIT
- +21 DO PTF^ORWGAPIA(NODE,.VALUE,.VALUES)
- SET VALUE=$$EXT^ORWGAPIX($GET(VALUE("DISCHARGE STATUS")),45,6)
- +22 ;*****************************
- IF NUM="DXLS"
- SET VALUE="(DXLS) "_VALUE_U_U_VALUES
- +23 SET RESULT=45_"DX"_U_ITEM_U_DATE_U_DATE2_U_" "_VALUE
- +24 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- End DoDot:2
- End DoDot:1
- +25 KILL ^TMP("ORWGRPC TEMP",$JOB)
- +26 QUIT
- +27 ;
- LAB(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- +1 NEW COMMENT,DATE,DATE2,NODE,RESULT,TYPE,VALUE
- KILL VALUE
- +2 SET DATE=""
- SET DATE2=""
- SET CNT=$GET(CNT)
- SET BACKTO=+$GET(BACKTO)
- +3 Begin DoDot:1
- +4 IF $EXTRACT(ITEM)="A"
- SET TYPE="AP"
- QUIT
- +5 IF $EXTRACT(ITEM)="M"
- SET TYPE="MI"
- QUIT
- +6 SET TYPE=""
- QUIT
- End DoDot:1
- +7 FOR
- SET DATE=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM,DATE))
- if DATE=""
- QUIT
- Begin DoDot:1
- +8 IF DATE>START
- QUIT
- +9 IF DATE<BACKTO
- QUIT
- +10 SET NODE=""
- +11 FOR
- SET NODE=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM,DATE,NODE))
- if NODE=""
- QUIT
- Begin DoDot:2
- +12 KILL VALUE
- +13 DO LAB^ORWGAPIC(.VALUE,NODE,ITEM)
- +14 ;_U_$P(VALUE,U,2)
- IF TYPE="AP"
- SET RESULT="63AP^"_ITEM_U_DATE_U_DATE2
- +15 IF TYPE="MI"
- SET RESULT="63MI^"_ITEM_U_DATE_U_DATE2_U_$PIECE(VALUE,U,4)
- +16 IF TYPE=""
- Begin DoDot:3
- +17 SET COMMENT=""
- +18 IF $LENGTH($GET(VALUE("COMMENTS",1)))
- SET COMMENT=1
- +19 SET RESULT="63^"_ITEM_U_DATE_U_DATE2_U_$PIECE(VALUE,U,3)_U_$PIECE(VALUE,U,4)_U_$GET(VALUE("SPECIMEN"))_U_COMMENT
- +20 IF $LENGTH($PIECE(VALUE,U,7))
- SET $PIECE(RESULT,U,10)=$PIECE($PIECE(VALUE,U,7),"!",2,3)_U_$PIECE($PIECE(VALUE,U,7),"!",7)
- End DoDot:3
- +21 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- End DoDot:2
- End DoDot:1
- +22 QUIT
- +23 ;
- MED(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- +1 DO MED3^ORWGAPIE(.DATA,ITEM,START,DFN,.CNT,.TMP)
- +2 QUIT
- +3 ;
- NOTE(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- +1 NEW DATE,DOC,DOCCLASS,DOCTYPE,DUM,IEN,RESULT,RESULTS,TITLE,VALUE
- KILL DUM
- +2 KILL ^TMP("ORWGRPC TEMP",$JOB),^TMP("TIUR",$JOB)
- +3 SET CNT=$GET(CNT)
- SET ITEM=$$UP^ORWGAPIX(ITEM)
- SET BACKTO=+$GET(BACKTO)
- +4 FOR DOCTYPE="P","D","C"
- Begin DoDot:1
- +5 SET DOCCLASS=$$DOCCLASS^ORWGAPIA(DOCTYPE)
- +6 KILL ^TMP("TIUR",$JOB)
- +7 DO TIU^ORWGAPIA(.DUM,DOCCLASS,5,DFN)
- +8 SET DOC=0
- +9 FOR
- SET DOC=$ORDER(^TMP("TIUR",$JOB,DOC))
- if DOC<1
- QUIT
- Begin DoDot:2
- +10 SET RESULTS=^TMP("TIUR",$JOB,DOC)
- +11 SET IEN=+$PIECE(RESULTS,U)
- +12 SET TITLE=$$UP^ORWGAPIX($PIECE(RESULTS,U,2))
- +13 IF TITLE'=ITEM
- QUIT
- +14 ; do not use admission date S DATE=$P($G(^AUPNVSIT(+$P($G(^TIU(8925,IEN,0)),U,3),0)),U)
- +15 SET DATE=$PIECE(RESULTS,U,3)
- +16 IF DATE>START
- QUIT
- +17 IF DATE<BACKTO
- QUIT
- +18 SET VALUE=$PIECE(RESULTS,U,7)
- +19 SET CNT=CNT+1
- +20 SET RESULT=8925_U_TITLE_U_DATE_"^^"_VALUE
- +21 IF $DATA(^TMP("ORWGRPC TEMP",$JOB,RESULT))
- QUIT
- +22 SET ^TMP("ORWGRPC TEMP",$JOB,RESULT)=""
- +23 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- End DoDot:2
- End DoDot:1
- +24 KILL ^TMP("ORWGRPC TEMP",$JOB),^TMP("TIUR",$JOB)
- +25 QUIT
- +26 ;
- ORDER(DATA,ITEM,START,DFN,CNT,TMP,BACKTO) ; from ORWGAPIR
- +1 NEW DATE,DATE2,NODE,ORUPCHUK,RESULT,VALUE
- KILL ORUPCHUK
- +2 SET DATE=""
- SET CNT=$GET(CNT)
- SET BACKTO=+$GET(BACKTO)
- +3 FOR
- SET DATE=$ORDER(^PXRMINDX(100,"PI",DFN,ITEM,DATE))
- if DATE=""
- QUIT
- Begin DoDot:1
- +4 IF DATE>START
- QUIT
- +5 IF DATE<BACKTO
- QUIT
- +6 SET DATE2=""
- +7 FOR
- SET DATE2=$ORDER(^PXRMINDX(100,"PI",DFN,ITEM,DATE,DATE2))
- if DATE2=""
- QUIT
- Begin DoDot:2
- +8 SET NODE=""
- +9 FOR
- SET NODE=$ORDER(^PXRMINDX(100,"PI",DFN,ITEM,DATE,DATE2,NODE))
- if NODE=""
- QUIT
- Begin DoDot:3
- +10 DO EN^ORX8($PIECE(NODE,";"))
- SET VALUE=$PIECE($GET(ORUPCHUK("ORSTS")),U,2)
- +11 SET RESULT=100_U_ITEM_U_DATE_"^^"_VALUE
- +12 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +13 QUIT
- +14 ;
- RAD(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(70,"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(70,"PI",DFN,ITEM,DATE,NODE))
- if NODE=""
- QUIT
- Begin DoDot:2
- +8 DO RAD^ORWGAPIA(NODE,.VALUE,.VALUES)
- SET VALUE=$GET(VALUE("PDX"))_"-"_$GET(VALUE("EXAM STATUS"))_U_U_VALUES
- +9 SET RESULT=70_U_ITEM_U_DATE_U_DATE2_U_VALUE
- +10 DO SETUP^ORWGAPIW(.DATA,RESULT,TMP,.CNT)
- End DoDot:2
- End DoDot:1
- +11 QUIT
- +12 ;