BEHOENPV ;IHS/CIA/MGH - Summary Report for Selected Encounter ;21-Jan-2013 17:05;DU
;;1.1;BEH COMPONENTS;**005002,005004,005009**;Mar 20, 2007
;=================================================================
;Added code to support eye, PHN and anticoag components
; RPC: Retrieve report
GETRPT(DATA,BEHVSIT,BEHFLG) ;EP
S DATA=$$TMPGBL^CIAVMRPC
I '$G(BEHVSIT) S @DATA@(1)="A visit has not been selected." Q
D CAPTURE^CIAUHFS("D REPORT^BEHOENPV(BEHVSIT,,.BEHFLG)",DATA,80)
S:'$D(@DATA) @DATA@(1)="No visit information was found."
Q
; RPC: Retrieve report
; Entry point for OE/RR REPORT file
OERRRPT(ROOT,ORDFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;EP
;N BEHVSIT
;S BEHVSIT=$$VSTR2VIS^BEHOENCX(ORDFN,$$GETVAR^CIANBUTL("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER"))
;D GETRPT(.ROOT,BEHVSIT)
D GETRPT(.ROOT,$$VSTR2VIS^BEHOENCX(ORDFN,$$GETVAR^CIANBUTL("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")))
Q
; RPC: Retrieve reports for date range
GETRPTS(DATA,DFN,BEHFLG,STRT,END) ;EP
S DATA=$$TMPGBL^CIAVMRPC
D CAPTURE^CIAUHFS("D REPORTS^BEHOENPV(DFN,.BEHFLG,STRT,END)",DATA,80)
S:'$D(@DATA) @DATA@(1)="No visits found within specified date range."
Q
; RPC: Retrieve report
; Entry point for OE/RR REPORT file
OERRRPTS(ROOT,ORDFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;EP
D GETRPTS(.ROOT,ORDFN,,ALPHA,OMEGA)
Q
REPORTS(DFN,BEHFLG,STRT,END) ;
N BEHVSIT,DAT
S BEHVSIT=0
F S BEHVSIT=$O(^AUPNVSIT("AC",DFN,BEHVSIT)) Q:'BEHVSIT D
.S DAT=+$G(^AUPNVSIT(BEHVSIT,0))
.I DAT,DAT'<STRT,DAT'>END D
..D REPORT(BEHVSIT,,.BEHFLG)
..W !!,$$REPEAT^XLFSTR("=",80),!
Q
OERRPB(ROOT,DFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;EP
N BEHFLAG,ORDFN,XQORNOD
Q:'$G(DFN)
S ORDFN=DFN_";DPT(",XQORNOD=1
D REPORT(+$G(ORVSIT),,.BEHFLAG)
Q
; Generate specified report segments for a visit abstract
REPORT(BEHVSIT,BEHQUIT,BEHFLG) ;
N BEHLP,BEHRTN,BEHTBL,X,Y,DFN,I,TODAY,PAGE,LINE,ORLIST,HDR
N BEHNAME,BEHDOB,BEHHRN,BEHVLOC,BEHVPRV,BEHVDT,BEHVFAC,BEHDOCID
Q:BEHVSIT'>0
;Get the visit information needed for the header
;This information stays for each page of the report
S PAGE=0,LINE=0
D DFN(BEHVSIT)
;Loop through the items to be included in the report in their assigned order
F BEHLP=0:1 S X=$P($T(FLAG+BEHLP),";;",2,99) Q:'$L(X) D
.S Y=$P(X,";")
.S BEHTBL(Y,0)=$P(X,";",2),BEHTBL(Y,1)=$P(X,";",3,99)
S BEHFLG=$G(BEHFLG,"CMIKEPHNORVTYAU")
F BEHLP=1:1:$L(BEHFLG) D Q:$G(BEHQUIT)
.S X=$E(BEHFLG,BEHLP)
.I $D(BEHTBL(X)),@BEHTBL(X,1) D @(BEHTBL(X,0)_"(BEHVSIT,DFN,.BEHQUIT)")
K ^TMP("ORR",$J)
Q
; Report flag control
FLAG ;;C;CHIEF;$L($T(^BEHOENPP))
;;N;NOTES;$D(^TIU)
;;S;NOTES2;$D(^TIU)
;;O;ORDERS;$L($T(^ORQ1))
;;E;EXAMS;$L($T(^BEHOENPP))
;;H;FACTORS;$L($T(^BEHOENPP))
;;P;EDU;$L($T(^BEHOENPP))
;;V;POV;$L($T(^BEHOENPP))
;;M;MEAS;$L($T(^BEHOENPP))
;;I;IMMUN;$L($T(^BEHOENPP))
;;K;SKIN;$L($T(^BEHOENPP))
;;R;RESULTS;$L($T(^BEHOENPR))
;;T;CPT;$L($T(^BEHOENPP))
;;Y;EYE;$L($T(^BEHOENPP))
;;A;ANTICOAG;$L($T(^BEHOENPP))
;;U;PHN;$L($T(^BEHOENPP))
;;
; Display all notes associated with specified visit
; Optionally limit notes to those with the specified status (BEHST).
NOTES(BEHVSIT,DFN,BEHQUIT,BEHST) ;
N IEN,NAME
S NAME="PROGRESS NOTES"
F IEN=0:0 S IEN=$O(^TIU(8925,"V",BEHVSIT,IEN)) Q:'IEN D Q:$G(BEHQUIT)
.D:$L(NAME) HDR(NAME,1)
.S NAME=""
.D GETPN(IEN)
Q
CHIEF(BEHVSIT,DFN,BEHQUIT) ;Get the chief complaint for this visit
D CHIEF^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
Q
EXAMS(BEHVSIT,DFN,BEHQUIT) ;Get the exams for this visit
D EXAMS^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
Q
FACTORS(BEHVSIT,DFN,BEHQUIT) ;Get the health factors for this visit
D FACTORS^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
Q
EDU(BEHVSIT,DFN,BEHQUIT) ;Get the education topics for this visit
D EDU^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
Q
EYE(BEHVSIT,DFN,BEHQUIT) ;Get the education topics for this visit
D EYE^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
Q
ANTICOAG(BEHVSIT,DFN,BEHQUIT) ;Get the education topics for this visit
D ANTICOAG^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
Q
PHN(BEHVSIT,DFN,BEHQUIT) ;Get the education topics for this visit
D PHN^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
Q
; Display all orders associated with specified visit
ORDERS(BEHVSIT,DFN,BEHQUIT) ;
N DAT,DFN,ORD,HDR,HLF,LOC,X,Y
S X=$G(^AUPNVSIT(BEHVSIT,0)),DAT=X\1,DFN=$P(X,U,5),LOC=$P(X,U,22)_";SC(",HLF=IOM\2
Q:'DAT
K ^TMP("ORR",$J)
D EN^ORQ1(DFN_";DPT(",,1,1,DAT,DAT,1)
Q:'$D(ORLIST)
Q:'$O(^TMP("ORR",$J,ORLIST,0))
S NAME="ORDERS"
D HDR(NAME,1)
F X=0:0 S X=$O(^TMP("ORR",$J,ORLIST,X)) Q:'X K ORD M ORD=^(X) D Q:$G(BEHQUIT)
.S Y=$P($G(^OR(100,+ORD,0)),U,10)
.I $L(Y),Y'=LOC Q
.S LINE=LINE+7
.I LINE>(IOSL-3) D HDR(NAME,5)
.W !,"ORDER #: ",+ORD,?HLF,"STATUS: ",$P(ORD,U,6),!
.W "START: ",$$FMTE^XLFDT($P(ORD,U,4)),?HLF,"STOP: ",$$FMTE^XLFDT($P(ORD,U,5)),!
.F Y=0:0 S Y=$O(ORD("TX",Y)) Q:'Y W ORD("TX",Y),!
.W !
Q
; Extract specified note
GETPN(TIUDA) ;
Q:'$$CANDO^TIULP(TIUDA,"VIEW")
N GBL,ERR,TIU,HLF,IDX,HDR,STAT
S GBL=$NA(^TMP("BEHOENPV",$J)),HLF=IOM\2
K @GBL
D EXTRACT^TIULQ(TIUDA,GBL,.ERR,".01;.02;.03;.05;.07;.08;1202;1203;1205;1208;1209;1301;1307;1402;1501:1505;1507:1513;1701","",1,"E")
M TIU=^TMP("BEHOENPV",$J,TIUDA)
K ^TMP("BEHOENPV",$J)
Q:$G(ERR)
S HDR=TIU(.01,"E")
;S LINE=LINE+3
D HDR(HDR,3)
W !,"AUTHOR: ",TIU(1202,"E")
W:$L(TIU(1502,"E")) ?HLF,"SIGNED BY: ",TIU(1502,"E")
W !,"STATUS: ",TIU(.05,"E"),!
S STAT=$$GET1^DIQ(8925,TIUDA,.05,"I")
Q:STAT'=7
F IDX=0:0 S IDX=$O(TIU("TEXT",IDX)) Q:'IDX D Q:$G(BEHQUIT)
.S LINE=LINE+1
.I LINE>(IOSL-3) D HDR(HDR,1)
.W:'$G(BEHQUIT) TIU("TEXT",IDX,0),!
I '$G(BEHQUIT),$L($G(TIU(1501,"E"))) D
.I LINE+2>(IOSL-3) D HDR(HDR,2)
.W !,"/es/ "_$G(TIU(1503,"E"))
.W !,"Signed: "_$G(TIU(1501,"E"))
Q
POV(BEHVSIT,DFN,BEHQUIT) ;Get the POVs for this visit
D POV^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
Q
MEAS(BEHVSIT,DFN,BEHQUIT) ;Get the measurments for this visit
D MEAS^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
Q
IMMUN(BEHVSIT,DFN,BEHQUIT) ;Get the immunizations for this visit
D IMMUN^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
Q
SKIN(BEHVSIT,DFN,BEHQUIT) ;Get the skin tests for this visit
D SKIN^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
Q
CPT(BEHVSIT,DFN,BEHQUIT) ;Get the CPT codes forthis visit
D CPT^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
Q
RESULTS(BEHVSIT,DFN,BEHQUIT) ;Get the results for the orders
D RESULTS^BEHOENPR(BEHVSIT,DFN,.ORLIST,.BEHQUIT)
Q
; Get DFN from visit ien
DFN(BEHVSIT) ;
N BEHI,TEMP,VADM,X
S DFN=$P($G(^AUPNVSIT(BEHVSIT,0)),U,5)
D DEM^VADPT
S BEHNAME=$G(VADM(1)),BEHDOB=$P($G(VADM(3)),U,2),BEHHRN=$$HRN^BEHOPTCX(DFN)
S BEHVDT=$$ENTRY^CIAUDT(+$G(^AUPNVSIT(BEHVSIT,0)))
S TEMP=+$P($G(^AUPNVSIT(BEHVSIT,0)),U,22)
S BEHVLOC=$P($G(^SC(TEMP,0)),U,1)
S TEMP=$P($G(^AUPNVSIT(BEHVSIT,0)),U,6)
S BEHVFAC=$P($G(^AUTTLOC(TEMP,0)),U,2)
S BEHI=""
K BEHVPRV
F S BEHI=$O(^AUPNVPRV("AD",BEHVSIT,BEHI)) Q:BEHI="" D
.S X=$G(^AUPNVPRV(BEHI,0))
.S BEHDOCID=$P(X,U),X=$P(X,U,4)
.I BEHDOCID="" S BEHVPRV(BEHI)="Unknown"
.E S BEHVPRV($S(X="P":0,1:BEHI))=$P($G(^VA(200,BEHDOCID,0)),U,1)_"("_X_")"
D HDR1
Q
; Start new page and output header if exceed line count
HDR1 S CNT=$G(CNT,1),PAGE=PAGE+1
S HDR(1)="CLINIC: "_BEHVLOC
S HDR(2)="LOC. OF ENCOUNTER: "_BEHVFAC
S HDR(3)="VISIT/ADMIT DATE&TIME: "_BEHVDT
S HDR(4)=""
S:$D(BEHVPRV(0)) HDR(4)="ENCOUNTER PROVIDER(s): "_BEHVPRV(0)
W @IOF,!,HDR(1),?IOM-$L(HDR(2)),HDR(2),!
W !,HDR(3)
W !,HDR(4),!
F I=1:1:IOM W "_"
W !
S LINE=8
F I=0:0 S I=$O(BEHVPRV(I)) Q:'I D
.W !,$$RJ^XLFSTR(BEHVPRV(I),30)
.S LINE=LINE+1
Q
HDR(NAME,CNT) ;EP
N HDR
S LINE=LINE+CNT
I LINE<(IOSL-CNT) D
.S HDR=$$CJ^XLFSTR(" "_NAME_" ",IOM,"-")
.W !!,HDR
.S LINE=LINE+CNT+1
E D
.I PAGE>0,$E(IOST)="C" D Q:$G(BEHQUIT)
..N X
..W !
..R "Press RETURN or ENTER to continue...",X:$G(DTIME,300),!
..S:X[U!'$T BEHQUIT=1
.E W !,$$CJ^XLFSTR("Continued on next page ==>",IOM)
.S LINE=4,PAGE=PAGE+1
.S HDR(2)="HRN: "_BEHHRN,HDR(3)="DOS: "_BEHVDT,HDR(4)="VISIT IEN: "_BEHVSIT
.S HDR=$$CJ^XLFSTR(" "_NAME_" ",IOM,"-")
.W @IOF,!,HDR(2),?IOM-$L(HDR(3))\2,HDR(3),?IOM-$L(HDR(4)),HDR(4),!,HDR,!
.W $$CJ^XLFSTR("<Page "_PAGE_">",IOM),!
Q
BEHOENPV ;IHS/CIA/MGH - Summary Report for Selected Encounter ;21-Jan-2013 17:05;DU
+1 ;;1.1;BEH COMPONENTS;**005002,005004,005009**;Mar 20, 2007
+2 ;=================================================================
+3 ;Added code to support eye, PHN and anticoag components
+4 ; RPC: Retrieve report
GETRPT(DATA,BEHVSIT,BEHFLG) ;EP
+1 SET DATA=$$TMPGBL^CIAVMRPC
+2 IF '$GET(BEHVSIT)
SET @DATA@(1)="A visit has not been selected."
QUIT
+3 DO CAPTURE^CIAUHFS("D REPORT^BEHOENPV(BEHVSIT,,.BEHFLG)",DATA,80)
+4 IF '$DATA(@DATA)
SET @DATA@(1)="No visit information was found."
+5 QUIT
+6 ; RPC: Retrieve report
+7 ; Entry point for OE/RR REPORT file
OERRRPT(ROOT,ORDFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;EP
+1 ;N BEHVSIT
+2 ;S BEHVSIT=$$VSTR2VIS^BEHOENCX(ORDFN,$$GETVAR^CIANBUTL("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER"))
+3 ;D GETRPT(.ROOT,BEHVSIT)
+4 DO GETRPT(.ROOT,$$VSTR2VIS^BEHOENCX(ORDFN,$$GETVAR^CIANBUTL("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")))
+5 QUIT
+6 ; RPC: Retrieve reports for date range
GETRPTS(DATA,DFN,BEHFLG,STRT,END) ;EP
+1 SET DATA=$$TMPGBL^CIAVMRPC
+2 DO CAPTURE^CIAUHFS("D REPORTS^BEHOENPV(DFN,.BEHFLG,STRT,END)",DATA,80)
+3 IF '$DATA(@DATA)
SET @DATA@(1)="No visits found within specified date range."
+4 QUIT
+5 ; RPC: Retrieve report
+6 ; Entry point for OE/RR REPORT file
OERRRPTS(ROOT,ORDFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;EP
+1 DO GETRPTS(.ROOT,ORDFN,,ALPHA,OMEGA)
+2 QUIT
REPORTS(DFN,BEHFLG,STRT,END) ;
+1 NEW BEHVSIT,DAT
+2 SET BEHVSIT=0
+3 FOR
SET BEHVSIT=$ORDER(^AUPNVSIT("AC",DFN,BEHVSIT))
IF 'BEHVSIT
QUIT
Begin DoDot:1
+4 SET DAT=+$GET(^AUPNVSIT(BEHVSIT,0))
+5 IF DAT
IF DAT'<STRT
IF DAT'>END
Begin DoDot:2
+6 DO REPORT(BEHVSIT,,.BEHFLG)
+7 WRITE !!,$$REPEAT^XLFSTR("=",80),!
End DoDot:2
End DoDot:1
+8 QUIT
OERRPB(ROOT,DFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;EP
+1 NEW BEHFLAG,ORDFN,XQORNOD
+2 IF '$GET(DFN)
QUIT
+3 SET ORDFN=DFN_";DPT("
SET XQORNOD=1
+4 DO REPORT(+$GET(ORVSIT),,.BEHFLAG)
+5 QUIT
+6 ; Generate specified report segments for a visit abstract
REPORT(BEHVSIT,BEHQUIT,BEHFLG) ;
+1 NEW BEHLP,BEHRTN,BEHTBL,X,Y,DFN,I,TODAY,PAGE,LINE,ORLIST,HDR
+2 NEW BEHNAME,BEHDOB,BEHHRN,BEHVLOC,BEHVPRV,BEHVDT,BEHVFAC,BEHDOCID
+3 IF BEHVSIT'>0
QUIT
+4 ;Get the visit information needed for the header
+5 ;This information stays for each page of the report
+6 SET PAGE=0
SET LINE=0
+7 DO DFN(BEHVSIT)
+8 ;Loop through the items to be included in the report in their assigned order
+9 FOR BEHLP=0:1
SET X=$PIECE($TEXT(FLAG+BEHLP),";;",2,99)
IF '$LENGTH(X)
QUIT
Begin DoDot:1
+10 SET Y=$PIECE(X,";")
+11 SET BEHTBL(Y,0)=$PIECE(X,";",2)
SET BEHTBL(Y,1)=$PIECE(X,";",3,99)
End DoDot:1
+12 SET BEHFLG=$GET(BEHFLG,"CMIKEPHNORVTYAU")
+13 FOR BEHLP=1:1:$LENGTH(BEHFLG)
Begin DoDot:1
+14 SET X=$EXTRACT(BEHFLG,BEHLP)
+15 IF $DATA(BEHTBL(X))
IF @BEHTBL(X,1)
DO @(BEHTBL(X,0)_"(BEHVSIT,DFN,.BEHQUIT)")
End DoDot:1
IF $GET(BEHQUIT)
QUIT
+16 KILL ^TMP("ORR",$JOB)
+17 QUIT
+18 ; Report flag control
FLAG ;;C;CHIEF;$L($T(^BEHOENPP))
+1 ;;N;NOTES;$D(^TIU)
+2 ;;S;NOTES2;$D(^TIU)
+3 ;;O;ORDERS;$L($T(^ORQ1))
+4 ;;E;EXAMS;$L($T(^BEHOENPP))
+5 ;;H;FACTORS;$L($T(^BEHOENPP))
+6 ;;P;EDU;$L($T(^BEHOENPP))
+7 ;;V;POV;$L($T(^BEHOENPP))
+8 ;;M;MEAS;$L($T(^BEHOENPP))
+9 ;;I;IMMUN;$L($T(^BEHOENPP))
+10 ;;K;SKIN;$L($T(^BEHOENPP))
+11 ;;R;RESULTS;$L($T(^BEHOENPR))
+12 ;;T;CPT;$L($T(^BEHOENPP))
+13 ;;Y;EYE;$L($T(^BEHOENPP))
+14 ;;A;ANTICOAG;$L($T(^BEHOENPP))
+15 ;;U;PHN;$L($T(^BEHOENPP))
+16 ;;
+17 ; Display all notes associated with specified visit
+18 ; Optionally limit notes to those with the specified status (BEHST).
NOTES(BEHVSIT,DFN,BEHQUIT,BEHST) ;
+1 NEW IEN,NAME
+2 SET NAME="PROGRESS NOTES"
+3 FOR IEN=0:0
SET IEN=$ORDER(^TIU(8925,"V",BEHVSIT,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+4 IF $LENGTH(NAME)
DO HDR(NAME,1)
+5 SET NAME=""
+6 DO GETPN(IEN)
End DoDot:1
IF $GET(BEHQUIT)
QUIT
+7 QUIT
CHIEF(BEHVSIT,DFN,BEHQUIT) ;Get the chief complaint for this visit
+1 DO CHIEF^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
+2 QUIT
EXAMS(BEHVSIT,DFN,BEHQUIT) ;Get the exams for this visit
+1 DO EXAMS^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
+2 QUIT
FACTORS(BEHVSIT,DFN,BEHQUIT) ;Get the health factors for this visit
+1 DO FACTORS^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
+2 QUIT
EDU(BEHVSIT,DFN,BEHQUIT) ;Get the education topics for this visit
+1 DO EDU^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
+2 QUIT
EYE(BEHVSIT,DFN,BEHQUIT) ;Get the education topics for this visit
+1 DO EYE^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
+2 QUIT
ANTICOAG(BEHVSIT,DFN,BEHQUIT) ;Get the education topics for this visit
+1 DO ANTICOAG^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
+2 QUIT
PHN(BEHVSIT,DFN,BEHQUIT) ;Get the education topics for this visit
+1 DO PHN^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
+2 QUIT
+3 ; Display all orders associated with specified visit
ORDERS(BEHVSIT,DFN,BEHQUIT) ;
+1 NEW DAT,DFN,ORD,HDR,HLF,LOC,X,Y
+2 SET X=$GET(^AUPNVSIT(BEHVSIT,0))
SET DAT=X\1
SET DFN=$PIECE(X,U,5)
SET LOC=$PIECE(X,U,22)_";SC("
SET HLF=IOM\2
+3 IF 'DAT
QUIT
+4 KILL ^TMP("ORR",$JOB)
+5 DO EN^ORQ1(DFN_";DPT(",,1,1,DAT,DAT,1)
+6 IF '$DATA(ORLIST)
QUIT
+7 IF '$ORDER(^TMP("ORR",$JOB,ORLIST,0))
QUIT
+8 SET NAME="ORDERS"
+9 DO HDR(NAME,1)
+10 FOR X=0:0
SET X=$ORDER(^TMP("ORR",$JOB,ORLIST,X))
IF 'X
QUIT
KILL ORD
MERGE ORD=^(X)
Begin DoDot:1
+11 SET Y=$PIECE($GET(^OR(100,+ORD,0)),U,10)
+12 IF $LENGTH(Y)
IF Y'=LOC
QUIT
+13 SET LINE=LINE+7
+14 IF LINE>(IOSL-3)
DO HDR(NAME,5)
+15 WRITE !,"ORDER #: ",+ORD,?HLF,"STATUS: ",$PIECE(ORD,U,6),!
+16 WRITE "START: ",$$FMTE^XLFDT($PIECE(ORD,U,4)),?HLF,"STOP: ",$$FMTE^XLFDT($PIECE(ORD,U,5)),!
+17 FOR Y=0:0
SET Y=$ORDER(ORD("TX",Y))
IF 'Y
QUIT
WRITE ORD("TX",Y),!
+18 WRITE !
End DoDot:1
IF $GET(BEHQUIT)
QUIT
+19 QUIT
+20 ; Extract specified note
GETPN(TIUDA) ;
+1 IF '$$CANDO^TIULP(TIUDA,"VIEW")
QUIT
+2 NEW GBL,ERR,TIU,HLF,IDX,HDR,STAT
+3 SET GBL=$NAME(^TMP("BEHOENPV",$JOB))
SET HLF=IOM\2
+4 KILL @GBL
+5 DO EXTRACT^TIULQ(TIUDA,GBL,.ERR,".01;.02;.03;.05;.07;.08;1202;1203;1205;1208;1209;1301;1307;1402;1501:1505;1507:1513;1701","",1,"E")
+6 MERGE TIU=^TMP("BEHOENPV",$JOB,TIUDA)
+7 KILL ^TMP("BEHOENPV",$JOB)
+8 IF $GET(ERR)
QUIT
+9 SET HDR=TIU(.01,"E")
+10 ;S LINE=LINE+3
+11 DO HDR(HDR,3)
+12 WRITE !,"AUTHOR: ",TIU(1202,"E")
+13 IF $LENGTH(TIU(1502,"E"))
WRITE ?HLF,"SIGNED BY: ",TIU(1502,"E")
+14 WRITE !,"STATUS: ",TIU(.05,"E"),!
+15 SET STAT=$$GET1^DIQ(8925,TIUDA,.05,"I")
+16 IF STAT'=7
QUIT
+17 FOR IDX=0:0
SET IDX=$ORDER(TIU("TEXT",IDX))
IF 'IDX
QUIT
Begin DoDot:1
+18 SET LINE=LINE+1
+19 IF LINE>(IOSL-3)
DO HDR(HDR,1)
+20 IF '$GET(BEHQUIT)
WRITE TIU("TEXT",IDX,0),!
End DoDot:1
IF $GET(BEHQUIT)
QUIT
+21 IF '$GET(BEHQUIT)
IF $LENGTH($GET(TIU(1501,"E")))
Begin DoDot:1
+22 IF LINE+2>(IOSL-3)
DO HDR(HDR,2)
+23 WRITE !,"/es/ "_$GET(TIU(1503,"E"))
+24 WRITE !,"Signed: "_$GET(TIU(1501,"E"))
End DoDot:1
+25 QUIT
POV(BEHVSIT,DFN,BEHQUIT) ;Get the POVs for this visit
+1 DO POV^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
+2 QUIT
MEAS(BEHVSIT,DFN,BEHQUIT) ;Get the measurments for this visit
+1 DO MEAS^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
+2 QUIT
IMMUN(BEHVSIT,DFN,BEHQUIT) ;Get the immunizations for this visit
+1 DO IMMUN^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
+2 QUIT
SKIN(BEHVSIT,DFN,BEHQUIT) ;Get the skin tests for this visit
+1 DO SKIN^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
+2 QUIT
CPT(BEHVSIT,DFN,BEHQUIT) ;Get the CPT codes forthis visit
+1 DO CPT^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
+2 QUIT
RESULTS(BEHVSIT,DFN,BEHQUIT) ;Get the results for the orders
+1 DO RESULTS^BEHOENPR(BEHVSIT,DFN,.ORLIST,.BEHQUIT)
+2 QUIT
+3 ; Get DFN from visit ien
DFN(BEHVSIT) ;
+1 NEW BEHI,TEMP,VADM,X
+2 SET DFN=$PIECE($GET(^AUPNVSIT(BEHVSIT,0)),U,5)
+3 DO DEM^VADPT
+4 SET BEHNAME=$GET(VADM(1))
SET BEHDOB=$PIECE($GET(VADM(3)),U,2)
SET BEHHRN=$$HRN^BEHOPTCX(DFN)
+5 SET BEHVDT=$$ENTRY^CIAUDT(+$GET(^AUPNVSIT(BEHVSIT,0)))
+6 SET TEMP=+$PIECE($GET(^AUPNVSIT(BEHVSIT,0)),U,22)
+7 SET BEHVLOC=$PIECE($GET(^SC(TEMP,0)),U,1)
+8 SET TEMP=$PIECE($GET(^AUPNVSIT(BEHVSIT,0)),U,6)
+9 SET BEHVFAC=$PIECE($GET(^AUTTLOC(TEMP,0)),U,2)
+10 SET BEHI=""
+11 KILL BEHVPRV
+12 FOR
SET BEHI=$ORDER(^AUPNVPRV("AD",BEHVSIT,BEHI))
IF BEHI=""
QUIT
Begin DoDot:1
+13 SET X=$GET(^AUPNVPRV(BEHI,0))
+14 SET BEHDOCID=$PIECE(X,U)
SET X=$PIECE(X,U,4)
+15 IF BEHDOCID=""
SET BEHVPRV(BEHI)="Unknown"
+16 IF '$TEST
SET BEHVPRV($SELECT(X="P":0,1:BEHI))=$PIECE($GET(^VA(200,BEHDOCID,0)),U,1)_"("_X_")"
End DoDot:1
+17 DO HDR1
+18 QUIT
+19 ; Start new page and output header if exceed line count
HDR1 SET CNT=$GET(CNT,1)
SET PAGE=PAGE+1
+1 SET HDR(1)="CLINIC: "_BEHVLOC
+2 SET HDR(2)="LOC. OF ENCOUNTER: "_BEHVFAC
+3 SET HDR(3)="VISIT/ADMIT DATE&TIME: "_BEHVDT
+4 SET HDR(4)=""
+5 IF $DATA(BEHVPRV(0))
SET HDR(4)="ENCOUNTER PROVIDER(s): "_BEHVPRV(0)
+6 WRITE @IOF,!,HDR(1),?IOM-$LENGTH(HDR(2)),HDR(2),!
+7 WRITE !,HDR(3)
+8 WRITE !,HDR(4),!
+9 FOR I=1:1:IOM
WRITE "_"
+10 WRITE !
+11 SET LINE=8
+12 FOR I=0:0
SET I=$ORDER(BEHVPRV(I))
IF 'I
QUIT
Begin DoDot:1
+13 WRITE !,$$RJ^XLFSTR(BEHVPRV(I),30)
+14 SET LINE=LINE+1
End DoDot:1
+15 QUIT
HDR(NAME,CNT) ;EP
+1 NEW HDR
+2 SET LINE=LINE+CNT
+3 IF LINE<(IOSL-CNT)
Begin DoDot:1
+4 SET HDR=$$CJ^XLFSTR(" "_NAME_" ",IOM,"-")
+5 WRITE !!,HDR
+6 SET LINE=LINE+CNT+1
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 IF PAGE>0
IF $EXTRACT(IOST)="C"
Begin DoDot:2
+9 NEW X
+10 WRITE !
+11 READ "Press RETURN or ENTER to continue...",X:$GET(DTIME,300),!
+12 IF X[U!'$TEST
SET BEHQUIT=1
End DoDot:2
IF $GET(BEHQUIT)
QUIT
+13 IF '$TEST
WRITE !,$$CJ^XLFSTR("Continued on next page ==>",IOM)
+14 SET LINE=4
SET PAGE=PAGE+1
+15 SET HDR(2)="HRN: "_BEHHRN
SET HDR(3)="DOS: "_BEHVDT
SET HDR(4)="VISIT IEN: "_BEHVSIT
+16 SET HDR=$$CJ^XLFSTR(" "_NAME_" ",IOM,"-")
+17 WRITE @IOF,!,HDR(2),?IOM-$LENGTH(HDR(3))\2,HDR(3),?IOM-$LENGTH(HDR(4)),HDR(4),!,HDR,!
+18 WRITE $$CJ^XLFSTR("<Page "_PAGE_">",IOM),!
End DoDot:1
+19 QUIT
