- BEHOENPR ;IHS/CIA/MGH - Summary Report for Selected Encounter ;20-Mar-2007 13:48;DKM
- ;;1.1;BEH COMPONENTS;**005001**;Mar 20, 2007
- ;=================================================================
- RESULTS(BEHVSIT,DFN,ORLIST,BEHQUIT) ;EP - Get the results of lab and radiolgy tests
- N BEHOR,STAT,TYPE,BEHONE,BEHARRAY,BEHTYP,BEHORD
- S BEHONE=0,CNT=0
- S BEHOR="" F S BEHOR=$O(^TMP("ORR",$J,ORLIST,BEHOR)) Q:BEHOR="" D
- .S BEHDATA=$G(^TMP("ORR",$J,ORLIST,BEHOR))
- .S ORDER=$P($P(BEHDATA,U,1),";",1)
- .S TYPE=$P(BEHDATA,U,2),STAT=$P(BEHDATA,U,6)
- .Q:STAT'="COMPLETE"&(STAT'="SCHEDULED")
- .I BEHONE=0 S NAME="RESULTS" D HDR^BEHOENPV(NAME,1) S BEHONE=1
- .I TYPE="CH"!(TYPE="MI")!(TYPE="LAB") S BEHARRAY("LAB",ORDER)=""
- .I TYPE="RAD" S BEHARRAY("RAD",ORDER)=""
- S BEHTYP="" F S BEHTYP=$O(BEHARRAY(BEHTYP)) Q:BEHTYP="" D
- .I BEHTYP="LAB" D LAB(DFN)
- .I BEHTYP="RAD" D XRAY(DFN)
- Q
- LAB(DFN) ;Return results of lab tests
- N NAME,BENORD
- S NAME="Lab Results"
- D HDR^BEHOENPV(NAME,1)
- S BEHORD="" F S BEHORD=$O(BEHARRAY(BEHTYP,BEHORD)) Q:BEHORD="" D
- .D EXPND(DFN,BEHORD,BEHORD)
- Q
- XRAY(DFN) ;Return Imagng results
- N NAME
- S NAME="Imaging results"
- D HDR^BEHOENPV(NAME,1)
- S BEHORD="" F S BEHORD=$O(BEHARRAY(BEHTYP,BEHORD)) Q:BEHORD="" D
- .D EXPND(DFN,BEHORD,BEHORD)
- Q
- EXPND(DFN,ORID,ID) ; Return results of order identified by ID
- K ^TMP("ORXPND",$J)
- N ORESULTS,ORVP,LCNT,BEHRES,BEHDATA
- S ORESULTS=1,LCNT=0,ORVP=DFN_";DPT("
- D ORDERS^ORCXPND1
- K ^TMP("ORXPND",$J,"VIDEO")
- S BEHRES="" F S BEHRES=$O(^TMP("ORXPND",$J,BEHRES)) Q:BEHRES="" D
- .S BEHDATA=$G(^TMP("ORXPND",$J,BEHRES,0))
- .S LINE=LINE+1
- .I LINE>(IOSL-3) D HDR^BEHOENPV(NAME,1)
- .W !,BEHDATA
- Q
- BEHOENPR ;IHS/CIA/MGH - Summary Report for Selected Encounter ;20-Mar-2007 13:48;DKM
- +1 ;;1.1;BEH COMPONENTS;**005001**;Mar 20, 2007
- +2 ;=================================================================
- RESULTS(BEHVSIT,DFN,ORLIST,BEHQUIT) ;EP - Get the results of lab and radiolgy tests
- +1 NEW BEHOR,STAT,TYPE,BEHONE,BEHARRAY,BEHTYP,BEHORD
- +2 SET BEHONE=0
- SET CNT=0
- +3 SET BEHOR=""
- FOR
- SET BEHOR=$ORDER(^TMP("ORR",$JOB,ORLIST,BEHOR))
- IF BEHOR=""
- QUIT
- Begin DoDot:1
- +4 SET BEHDATA=$GET(^TMP("ORR",$JOB,ORLIST,BEHOR))
- +5 SET ORDER=$PIECE($PIECE(BEHDATA,U,1),";",1)
- +6 SET TYPE=$PIECE(BEHDATA,U,2)
- SET STAT=$PIECE(BEHDATA,U,6)
- +7 IF STAT'="COMPLETE"&(STAT'="SCHEDULED")
- QUIT
- +8 IF BEHONE=0
- SET NAME="RESULTS"
- DO HDR^BEHOENPV(NAME,1)
- SET BEHONE=1
- +9 IF TYPE="CH"!(TYPE="MI")!(TYPE="LAB")
- SET BEHARRAY("LAB",ORDER)=""
- +10 IF TYPE="RAD"
- SET BEHARRAY("RAD",ORDER)=""
- End DoDot:1
- +11 SET BEHTYP=""
- FOR
- SET BEHTYP=$ORDER(BEHARRAY(BEHTYP))
- IF BEHTYP=""
- QUIT
- Begin DoDot:1
- +12 IF BEHTYP="LAB"
- DO LAB(DFN)
- +13 IF BEHTYP="RAD"
- DO XRAY(DFN)
- End DoDot:1
- +14 QUIT
- LAB(DFN) ;Return results of lab tests
- +1 NEW NAME,BENORD
- +2 SET NAME="Lab Results"
- +3 DO HDR^BEHOENPV(NAME,1)
- +4 SET BEHORD=""
- FOR
- SET BEHORD=$ORDER(BEHARRAY(BEHTYP,BEHORD))
- IF BEHORD=""
- QUIT
- Begin DoDot:1
- +5 DO EXPND(DFN,BEHORD,BEHORD)
- End DoDot:1
- +6 QUIT
- XRAY(DFN) ;Return Imagng results
- +1 NEW NAME
- +2 SET NAME="Imaging results"
- +3 DO HDR^BEHOENPV(NAME,1)
- +4 SET BEHORD=""
- FOR
- SET BEHORD=$ORDER(BEHARRAY(BEHTYP,BEHORD))
- IF BEHORD=""
- QUIT
- Begin DoDot:1
- +5 DO EXPND(DFN,BEHORD,BEHORD)
- End DoDot:1
- +6 QUIT
- EXPND(DFN,ORID,ID) ; Return results of order identified by ID
- +1 KILL ^TMP("ORXPND",$JOB)
- +2 NEW ORESULTS,ORVP,LCNT,BEHRES,BEHDATA
- +3 SET ORESULTS=1
- SET LCNT=0
- SET ORVP=DFN_";DPT("
- +4 DO ORDERS^ORCXPND1
- +5 KILL ^TMP("ORXPND",$JOB,"VIDEO")
- +6 SET BEHRES=""
- FOR
- SET BEHRES=$ORDER(^TMP("ORXPND",$JOB,BEHRES))
- IF BEHRES=""
- QUIT
- Begin DoDot:1
- +7 SET BEHDATA=$GET(^TMP("ORXPND",$JOB,BEHRES,0))
- +8 SET LINE=LINE+1
- +9 IF LINE>(IOSL-3)
- DO HDR^BEHOENPV(NAME,1)
- +10 WRITE !,BEHDATA
- End DoDot:1
- +11 QUIT
