BEHOENPR.m

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