BEHOENPS ;MSC/IND/DKM - Summary Report for Selected Encounter ;05-Jan-2010 08:03;PLS
;;1.1;BEH COMPONENTS;**005004**;Mar 20, 2007
;=================================================================
; Batch entry point
; BEHFLG = Which report sections to include (default to all)
; where N=all notes, S=signed notes O=orders, P=PCC data
BATCH(BEHFLG) ;EP
N BEHQUIT,BEHVSIT,BEHDAT1,BEHDAT,BEHDATX,BEHNOW,X
S BEHNOW=$$NOW^XLFDT,BEHNOW=$S(BEHNOW#1<.17:BEHNOW\1,1:$$FMADD^XLFDT(BEHNOW\1,-1))
S BEHDAT1=$$GET^XPAR("PKG","BEHOENPS SUMMARY START")\1
D:'BEHDAT1 ADD^XPAR("PKG","BEHOENPS SUMMARY START",,BEHNOW)
S BEHDAT2=$$GET^XPAR("PKG","BEHOENPS SUMMARY END")\1
D:'BEHDAT2 ADD^XPAR("PKG","BEHOENPS SUMMARY END",,BEHNOW)
Q:BEHDAT1>BEHNOW
I 'BEHDAT1 D
.S BEHDAT1=$$NOW^XLFDT,X=BEHDAT1#1,BEHDAT1=BEHDAT1\1
.S:X<.1 BEHDAT1=$$FMADD^XLFDT(BEHDAT1,-1)
S:BEHDAT2<BEHDAT1 BEHDAT2=BEHDAT1
S BEHDAT=BEHDAT1-.1,BEHDAT2=BEHDAT2+.9
U IO
F S BEHDAT=$O(^AUPNVSIT("B",BEHDAT)),BEHVSIT=0 Q:'BEHDAT!(BEHDAT>BEHDAT2) D Q:$G(BEHQUIT)
.F S BEHVSIT=$O(^AUPNVSIT("B",BEHDAT,BEHVSIT)) Q:'BEHVSIT D REPORT(BEHVSIT,.BEHQUIT,.BEHFLG) Q:$G(BEHQUIT)
S BEHDAT=$$FMADD^XLFDT(BEHNOW,1)
D ^%ZISC
Q:$G(BEHQUIT)
D CHG^XPAR("PKG","BEHOENPS SUMMARY START",,BEHDAT)
D CHG^XPAR("PKG","BEHOENPS SUMMARY END",,BEHDAT)
Q
; RPC: Retrieve report
GETRPT(DATA,BEHVSIT,BEHFLG) ;PEP - Retrieve report
S:'$L($G(DATA)) DATA=$$TMPGBL^CIAVMRPC(99)
I '$G(BEHVSIT) S @DATA@(1)="No visit has been selected." Q
D CAPTURE^CIAUHFS("D REPORT^BEHOENPS(BEHVSIT,.BEHFLG)",DATA,80)
S:'$D(@DATA) @DATA@(1)="No information on visit"
Q
; Entry point for OE/RR REPORT file
OERRRPT(ROOT,ORDFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;EP
D GETRPT(.ROOT,$$VSTR2VIS^BEHOENCX(ORDFN,$$GETVAR^CIANBUTL("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")))
Q
; Generate specified report segments for a visit abstract
REPORT(BEHVSIT,BEHQUIT,BEHFLG) ;EP
N BEHLP,BEHRTN,BEHTBL,X,Y
Q:BEHVSIT'>0
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,"SOPX")
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,.BEHQUIT)")
Q
; Report flag control
FLAG ;;N;NOTES;$D(^TIU)
;;S;NOTES2;$D(^TIU)
;;O;ORDERS;$L($T(^ORQ1))
;;P;PCC;$L($T(^APCDVDSP))
;;X;PCE;$L($T(PCE^BEHOENPS))
;;
; Display all notes associated with specified visit
; Optionally limit notes to those with the specified status (BEHST).
NOTES(BEHVSIT,BEHQUIT,BEHST) ;
N IEN
F IEN=0:0 S IEN=$O(^TIU(8925,"V",BEHVSIT,IEN)) Q:'IEN D Q:$G(BEHQUIT)
.I $L($G(BEHST)),$$STATUS^TIULC(IEN)'=BEHST Q
.D GETPN(IEN)
Q
; Display all signed notes associated with specific visit
NOTES2(BEHVSIT,BEHQUIT) ;
D NOTES(.BEHVSIT,.BEHQUIT,"completed")
Q
; Display all orders associated with specified visit
ORDERS(BEHVSIT,BEHQUIT) ;
N DAT,DFN,ORLIST,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)
S HDR="ORDERS"
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
.D HDR(.HDR,ORD("TX")+3)
.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 !
K ^TMP("ORR",$J)
Q
; Display all PCC data associated with specified visit
PCC(APCDVDSP,BEHQUIT) ;
Q:DUZ("AG")'="I"
D EN^APCDVDSP
;S:$G(APCDBRK) BEHQUIT=1
Q
; Extract specified note
GETPN(TIUDA) ;
Q:'$$CANDO^TIULP(TIUDA,"VIEW")
N GBL,ERR,TIU,HLF,IDX,HDR
S GBL=$NA(^TMP("BEHOENPS",$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("BEHOENPS",$J,TIUDA)
K ^TMP("BEHOENPS",$J)
Q:$G(ERR)
S HDR=TIU(.01,"E")
D HDR(.HDR)
W "AUTHOR: ",TIU(1202,"E"),?HLF,"PATIENT NAME: ",TIU(.02,"E"),!
W "SIGNED BY: ",TIU(1502,"E"),?HLF,"STATUS: ",TIU(.05,"E"),!
W "VISIT: ",TIU(.03,"E"),?HLF,"LOCATION: ",TIU(1205,"E"),!!
F IDX=0:0 S IDX=$O(TIU("TEXT",IDX)) Q:'IDX D Q:$G(BEHQUIT)
.D HDR(.HDR)
.W:'$G(BEHQUIT) TIU("TEXT",IDX,0),!
I '$G(BEHQUIT),$L($G(TIU(1501,"E"))) D
.W !,"/es/ "_$G(TIU(1503,"E"))
.W !,"Signed: "_$G(TIU(1501,"E"))
Q
; Get DFN from visit ien
DFN(BEHVSIT) ;
Q +$P($G(^AUPNVSIT(BEHVSIT,0)),U,5)
; Start new page and output header if exceed line count
HDR(HDR,CNT) ;
S CNT=$G(CNT,1),HDR(0)=$G(HDR(0),IOSL)+CNT
Q:HDR(0)<(IOSL-CNT)
I $D(HDR(1)),$E(IOST)="C" D Q:$G(BEHQUIT)
.N X
.R "Press RETURN or ENTER to continue...",X:$G(DTIME,300),!
.S:X[U!'$T BEHQUIT=1
E W:$D(HDR(1)) $$CJ^XLFSTR("Continued on next page ==>",IOM)
S HDR(0)=6,HDR(1)=$G(HDR(1))+1
S:'$D(HDR(2)) HDR(2)="HRN: "_$$HRN^BEHOPTCX($$DFN(BEHVSIT)),HDR(3)="DOS: "_$$ENTRY^CIAUDT(+$G(^AUPNVSIT(BEHVSIT,0))),HDR(4)="VISIT IEN: "_BEHVSIT,HDR=$$CJ^XLFSTR(" "_HDR_" ",IOM,"-")
W @IOF,!!!,HDR(2),?IOM-$L(HDR(3))\2,HDR(3),?IOM-$L(HDR(4)),HDR(4),!,HDR,!
W $$CJ^XLFSTR("<Page "_HDR(1)_">",IOM),!!
Q
PCE(BEHVSIT,BEHQUIT) ;Get visit information
;Added this entry point for non-IHS sites
Q:DUZ("AG")="I"
Q:'$D(BEHVSIT)
Q:'BEHVSIT
Q:'$D(^AUPNVSIT(BEHVSIT,0))
D DSP,EOJ
Q
DSP I $D(IOF),'$D(BEHOENPS("NO IOF")) W @IOF
N D0,DA,DIC,DIQ,DR,DL,DK,DX,S,X,XX
S BEHBRK=0 ;ACC
S BEHVDSH="-----------------------------"
S XX=$$^MSCDPTID(DFN)
S X="",$P(X,"~",80)="" W !!,X,!!,"VISIT IEN: ",BEHVSIT,!
S X="MRN: "_XX W !,X,!
W BEHVDSH," VISIT FILE ",BEHVDSH
S DIC="^AUPNVSIT(",DA=BEHVSIT D EN^DIQ
DSPLY1 ;DISPLAY V FILE DATA
S BEHVFLE=9000010 F BEHVL=0:0 S BEHVFLE=$O(^DIC(BEHVFLE)) Q:BEHVFLE>9000010.99!(BEHVFLE'=+BEHVFLE)!(BEHBRK) D DSPLY2
Q:BEHBRK ;ACC
I 'BEHBRK S X="",$P(X,"~",80)="" W !!,X,!!
Q
DSPLY2 S BEHVNM=$P(^DIC(BEHVFLE,0),U)
S BEHVDG=^DIC(BEHVFLE,0,"GL"),BEHVIGR=BEHVDG_"""AD"",BEHVSIT,BEHVDFN)"
S BEHVDFN="" F BEHVI=1:1 S BEHVDFN=$O(@BEHVIGR) Q:BEHVDFN=""!(BEHBRK) D DSPLY3 Q:BEHBRK
Q
DSPLY3 ;
I $Y>(IOSL-5) D HEAD Q:BEHBRK
I BEHVI<2 S X=20-$L(BEHVNM),Y=X\2,Z=X-Y W !,BEHVDSH,$J("",Z),BEHVNM,$J("",Y),BEHVDSH
S DIC=BEHVDG,DA=BEHVDFN,DIQ(0)="C" D EN^DIQ
Q
HEAD ;
I '$D(ZTQUEUED),'$D(IO("S")),$E(IOST)="C",IO=IO(0) W !!,"Enter to continue, '^' to halt " R BEHX:DTIME S:'$T BEHBRK=1 S:BEHX="^" BEHBRK=1
Q:BEHBRK
K S
W:$D(IOF) @IOF
Q
EOJ ; EOJ CLEANUP
I '$D(ZTQUEUED),'$D(IO("S")),'BEHBRK,'$D(BEHEIN),$E(IOST)="C",IO=IO(0) W !,"End of visit display, <ENTER> to Continue" R BEHX:DTIME
K X,Y
K BEHVDFN,BEHVDG,BEHVDSH,BEHVDSP,BEHVFLE,BEHVI,BEHVIGR,BEHVL,BEHVNM,BEHX,BEHBRK,BEHVSIT
Q
BEHOENPS ;MSC/IND/DKM - Summary Report for Selected Encounter ;05-Jan-2010 08:03;PLS
+1 ;;1.1;BEH COMPONENTS;**005004**;Mar 20, 2007
+2 ;=================================================================
+3 ; Batch entry point
+4 ; BEHFLG = Which report sections to include (default to all)
+5 ; where N=all notes, S=signed notes O=orders, P=PCC data
BATCH(BEHFLG) ;EP
+1 NEW BEHQUIT,BEHVSIT,BEHDAT1,BEHDAT,BEHDATX,BEHNOW,X
+2 SET BEHNOW=$$NOW^XLFDT
SET BEHNOW=$SELECT(BEHNOW#1<.17:BEHNOW\1,1:$$FMADD^XLFDT(BEHNOW\1,-1))
+3 SET BEHDAT1=$$GET^XPAR("PKG","BEHOENPS SUMMARY START")\1
+4 IF 'BEHDAT1
DO ADD^XPAR("PKG","BEHOENPS SUMMARY START",,BEHNOW)
+5 SET BEHDAT2=$$GET^XPAR("PKG","BEHOENPS SUMMARY END")\1
+6 IF 'BEHDAT2
DO ADD^XPAR("PKG","BEHOENPS SUMMARY END",,BEHNOW)
+7 IF BEHDAT1>BEHNOW
QUIT
+8 IF 'BEHDAT1
Begin DoDot:1
+9 SET BEHDAT1=$$NOW^XLFDT
SET X=BEHDAT1#1
SET BEHDAT1=BEHDAT1\1
+10 IF X<.1
SET BEHDAT1=$$FMADD^XLFDT(BEHDAT1,-1)
End DoDot:1
+11 IF BEHDAT2<BEHDAT1
SET BEHDAT2=BEHDAT1
+12 SET BEHDAT=BEHDAT1-.1
SET BEHDAT2=BEHDAT2+.9
+13 USE IO
+14 FOR
SET BEHDAT=$ORDER(^AUPNVSIT("B",BEHDAT))
SET BEHVSIT=0
IF 'BEHDAT!(BEHDAT>BEHDAT2)
QUIT
Begin DoDot:1
+15 FOR
SET BEHVSIT=$ORDER(^AUPNVSIT("B",BEHDAT,BEHVSIT))
IF 'BEHVSIT
QUIT
DO REPORT(BEHVSIT,.BEHQUIT,.BEHFLG)
IF $GET(BEHQUIT)
QUIT
End DoDot:1
IF $GET(BEHQUIT)
QUIT
+16 SET BEHDAT=$$FMADD^XLFDT(BEHNOW,1)
+17 DO ^%ZISC
+18 IF $GET(BEHQUIT)
QUIT
+19 DO CHG^XPAR("PKG","BEHOENPS SUMMARY START",,BEHDAT)
+20 DO CHG^XPAR("PKG","BEHOENPS SUMMARY END",,BEHDAT)
+21 QUIT
+22 ; RPC: Retrieve report
GETRPT(DATA,BEHVSIT,BEHFLG) ;PEP - Retrieve report
+1 IF '$LENGTH($GET(DATA))
SET DATA=$$TMPGBL^CIAVMRPC(99)
+2 IF '$GET(BEHVSIT)
SET @DATA@(1)="No visit has been selected."
QUIT
+3 DO CAPTURE^CIAUHFS("D REPORT^BEHOENPS(BEHVSIT,.BEHFLG)",DATA,80)
+4 IF '$DATA(@DATA)
SET @DATA@(1)="No information on visit"
+5 QUIT
+6 ; Entry point for OE/RR REPORT file
OERRRPT(ROOT,ORDFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;EP
+1 DO GETRPT(.ROOT,$$VSTR2VIS^BEHOENCX(ORDFN,$$GETVAR^CIANBUTL("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")))
+2 QUIT
+3 ; Generate specified report segments for a visit abstract
REPORT(BEHVSIT,BEHQUIT,BEHFLG) ;EP
+1 NEW BEHLP,BEHRTN,BEHTBL,X,Y
+2 IF BEHVSIT'>0
QUIT
+3 FOR BEHLP=0:1
SET X=$PIECE($TEXT(FLAG+BEHLP),";;",2,99)
IF '$LENGTH(X)
QUIT
Begin DoDot:1
+4 SET Y=$PIECE(X,";")
+5 SET BEHTBL(Y,0)=$PIECE(X,";",2)
SET BEHTBL(Y,1)=$PIECE(X,";",3,99)
End DoDot:1
+6 SET BEHFLG=$GET(BEHFLG,"SOPX")
+7 FOR BEHLP=1:1:$LENGTH(BEHFLG)
Begin DoDot:1
+8 SET X=$EXTRACT(BEHFLG,BEHLP)
+9 IF $DATA(BEHTBL(X))
IF @BEHTBL(X,1)
DO @(BEHTBL(X,0)_"(BEHVSIT,.BEHQUIT)")
End DoDot:1
IF $GET(BEHQUIT)
QUIT
+10 QUIT
+11 ; Report flag control
FLAG ;;N;NOTES;$D(^TIU)
+1 ;;S;NOTES2;$D(^TIU)
+2 ;;O;ORDERS;$L($T(^ORQ1))
+3 ;;P;PCC;$L($T(^APCDVDSP))
+4 ;;X;PCE;$L($T(PCE^BEHOENPS))
+5 ;;
+6 ; Display all notes associated with specified visit
+7 ; Optionally limit notes to those with the specified status (BEHST).
NOTES(BEHVSIT,BEHQUIT,BEHST) ;
+1 NEW IEN
+2 FOR IEN=0:0
SET IEN=$ORDER(^TIU(8925,"V",BEHVSIT,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+3 IF $LENGTH($GET(BEHST))
IF $$STATUS^TIULC(IEN)'=BEHST
QUIT
+4 DO GETPN(IEN)
End DoDot:1
IF $GET(BEHQUIT)
QUIT
+5 QUIT
+6 ; Display all signed notes associated with specific visit
NOTES2(BEHVSIT,BEHQUIT) ;
+1 DO NOTES(.BEHVSIT,.BEHQUIT,"completed")
+2 QUIT
+3 ; Display all orders associated with specified visit
ORDERS(BEHVSIT,BEHQUIT) ;
+1 NEW DAT,DFN,ORLIST,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 SET HDR="ORDERS"
+8 FOR X=0:0
SET X=$ORDER(^TMP("ORR",$JOB,ORLIST,X))
IF 'X
QUIT
KILL ORD
MERGE ORD=^(X)
Begin DoDot:1
+9 SET Y=$PIECE($GET(^OR(100,+ORD,0)),U,10)
+10 IF $LENGTH(Y)
IF Y'=LOC
QUIT
+11 DO HDR(.HDR,ORD("TX")+3)
+12 WRITE "ORDER #: ",+ORD,?HLF,"STATUS: ",$PIECE(ORD,U,6),!
+13 WRITE "START: ",$$FMTE^XLFDT($PIECE(ORD,U,4)),?HLF,"STOP: ",$$FMTE^XLFDT($PIECE(ORD,U,5)),!
+14 FOR Y=0:0
SET Y=$ORDER(ORD("TX",Y))
IF 'Y
QUIT
WRITE ORD("TX",Y),!
+15 WRITE !
End DoDot:1
IF $GET(BEHQUIT)
QUIT
+16 KILL ^TMP("ORR",$JOB)
+17 QUIT
+18 ; Display all PCC data associated with specified visit
PCC(APCDVDSP,BEHQUIT) ;
+1 IF DUZ("AG")'="I"
QUIT
+2 DO EN^APCDVDSP
+3 ;S:$G(APCDBRK) BEHQUIT=1
+4 QUIT
+5 ; Extract specified note
GETPN(TIUDA) ;
+1 IF '$$CANDO^TIULP(TIUDA,"VIEW")
QUIT
+2 NEW GBL,ERR,TIU,HLF,IDX,HDR
+3 SET GBL=$NAME(^TMP("BEHOENPS",$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("BEHOENPS",$JOB,TIUDA)
+7 KILL ^TMP("BEHOENPS",$JOB)
+8 IF $GET(ERR)
QUIT
+9 SET HDR=TIU(.01,"E")
+10 DO HDR(.HDR)
+11 WRITE "AUTHOR: ",TIU(1202,"E"),?HLF,"PATIENT NAME: ",TIU(.02,"E"),!
+12 WRITE "SIGNED BY: ",TIU(1502,"E"),?HLF,"STATUS: ",TIU(.05,"E"),!
+13 WRITE "VISIT: ",TIU(.03,"E"),?HLF,"LOCATION: ",TIU(1205,"E"),!!
+14 FOR IDX=0:0
SET IDX=$ORDER(TIU("TEXT",IDX))
IF 'IDX
QUIT
Begin DoDot:1
+15 DO HDR(.HDR)
+16 IF '$GET(BEHQUIT)
WRITE TIU("TEXT",IDX,0),!
End DoDot:1
IF $GET(BEHQUIT)
QUIT
+17 IF '$GET(BEHQUIT)
IF $LENGTH($GET(TIU(1501,"E")))
Begin DoDot:1
+18 WRITE !,"/es/ "_$GET(TIU(1503,"E"))
+19 WRITE !,"Signed: "_$GET(TIU(1501,"E"))
End DoDot:1
+20 QUIT
+21 ; Get DFN from visit ien
DFN(BEHVSIT) ;
+1 QUIT +$PIECE($GET(^AUPNVSIT(BEHVSIT,0)),U,5)
+2 ; Start new page and output header if exceed line count
HDR(HDR,CNT) ;
+1 SET CNT=$GET(CNT,1)
SET HDR(0)=$GET(HDR(0),IOSL)+CNT
+2 IF HDR(0)<(IOSL-CNT)
QUIT
+3 IF $DATA(HDR(1))
IF $EXTRACT(IOST)="C"
Begin DoDot:1
+4 NEW X
+5 READ "Press RETURN or ENTER to continue...",X:$GET(DTIME,300),!
+6 IF X[U!'$TEST
SET BEHQUIT=1
End DoDot:1
IF $GET(BEHQUIT)
QUIT
+7 IF '$TEST
IF $DATA(HDR(1))
WRITE $$CJ^XLFSTR("Continued on next page ==>",IOM)
+8 SET HDR(0)=6
SET HDR(1)=$GET(HDR(1))+1
+9 IF '$DATA(HDR(2))
SET HDR(2)="HRN: "_$$HRN^BEHOPTCX($$DFN(BEHVSIT))
SET HDR(3)="DOS: "_$$ENTRY^CIAUDT(+$GET(^AUPNVSIT(BEHVSIT,0)))
SET HDR(4)="VISIT IEN: "_BEHVSIT
SET HDR=$$CJ^XLFSTR(" "_HDR_" ",IOM,"-")
+10 WRITE @IOF,!!!,HDR(2),?IOM-$LENGTH(HDR(3))\2,HDR(3),?IOM-$LENGTH(HDR(4)),HDR(4),!,HDR,!
+11 WRITE $$CJ^XLFSTR("<Page "_HDR(1)_">",IOM),!!
+12 QUIT
PCE(BEHVSIT,BEHQUIT) ;Get visit information
+1 ;Added this entry point for non-IHS sites
+2 IF DUZ("AG")="I"
QUIT
+3 IF '$DATA(BEHVSIT)
QUIT
+4 IF 'BEHVSIT
QUIT
+5 IF '$DATA(^AUPNVSIT(BEHVSIT,0))
QUIT
+6 DO DSP
DO EOJ
+7 QUIT
DSP IF $DATA(IOF)
IF '$DATA(BEHOENPS("NO IOF"))
WRITE @IOF
+1 NEW D0,DA,DIC,DIQ,DR,DL,DK,DX,S,X,XX
+2 ;ACC
SET BEHBRK=0
+3 SET BEHVDSH="-----------------------------"
+4 SET XX=$$^MSCDPTID(DFN)
+5 SET X=""
SET $PIECE(X,"~",80)=""
WRITE !!,X,!!,"VISIT IEN: ",BEHVSIT,!
+6 SET X="MRN: "_XX
WRITE !,X,!
+7 WRITE BEHVDSH," VISIT FILE ",BEHVDSH
+8 SET DIC="^AUPNVSIT("
SET DA=BEHVSIT
DO EN^DIQ
DSPLY1 ;DISPLAY V FILE DATA
+1 SET BEHVFLE=9000010
FOR BEHVL=0:0
SET BEHVFLE=$ORDER(^DIC(BEHVFLE))
IF BEHVFLE>9000010.99!(BEHVFLE'=+BEHVFLE)!(BEHBRK)
QUIT
DO DSPLY2
+2 ;ACC
IF BEHBRK
QUIT
+3 IF 'BEHBRK
SET X=""
SET $PIECE(X,"~",80)=""
WRITE !!,X,!!
+4 QUIT
DSPLY2 SET BEHVNM=$PIECE(^DIC(BEHVFLE,0),U)
+1 SET BEHVDG=^DIC(BEHVFLE,0,"GL")
SET BEHVIGR=BEHVDG_"""AD"",BEHVSIT,BEHVDFN)"
+2 SET BEHVDFN=""
FOR BEHVI=1:1
SET BEHVDFN=$ORDER(@BEHVIGR)
IF BEHVDFN=""!(BEHBRK)
QUIT
DO DSPLY3
IF BEHBRK
QUIT
+3 QUIT
DSPLY3 ;
+1 IF $Y>(IOSL-5)
DO HEAD
IF BEHBRK
QUIT
+2 IF BEHVI<2
SET X=20-$LENGTH(BEHVNM)
SET Y=X\2
SET Z=X-Y
WRITE !,BEHVDSH,$JUSTIFY("",Z),BEHVNM,$JUSTIFY("",Y),BEHVDSH
+3 SET DIC=BEHVDG
SET DA=BEHVDFN
SET DIQ(0)="C"
DO EN^DIQ
+4 QUIT
HEAD ;
+1 IF '$DATA(ZTQUEUED)
IF '$DATA(IO("S"))
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !!,"Enter to continue, '^' to halt "
READ BEHX:DTIME
IF '$TEST
SET BEHBRK=1
IF BEHX="^"
SET BEHBRK=1
+2 IF BEHBRK
QUIT
+3 KILL S
+4 IF $DATA(IOF)
WRITE @IOF
+5 QUIT
EOJ ; EOJ CLEANUP
+1 IF '$DATA(ZTQUEUED)
IF '$DATA(IO("S"))
IF 'BEHBRK
IF '$DATA(BEHEIN)
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !,"End of visit display, <ENTER> to Continue"
READ BEHX:DTIME
+2 KILL X,Y
+3 KILL BEHVDFN,BEHVDG,BEHVDSH,BEHVDSP,BEHVFLE,BEHVI,BEHVIGR,BEHVL,BEHVNM,BEHX,BEHBRK,BEHVSIT
+4 QUIT
