BSDDPA ; IHS/ITSC/LJF, WAR - DISPLAY PAT APPTS ; [ 04/16/2004 4:40 PM ]
;;5.3;PIMS;**1003,1004**;MAY 28, 2004
;IHS/ITSC/LJF 05/13/2005 PATCH 1003 added EP; to EN subroutine
;IHS/OIT/LJF 07/20/2005 PATCH 1004 check if patient active on a wait list
; expanded default end date to 6 months from today
;
PAT ; -- ask user for patient
NEW DFN,BSDBD,BSDED
D KILL^AUPNPAT
S DFN=+$$READ^BDGF("PO^9000001:EQM","Select Patient") Q:DFN<1
;
S BSDBD=$$READ^BDGF("D^::EX","Select Beginning Date","TODAY") Q:'BSDBD
;
;;IHS/OIT/LJF 7/20/2005 PATCH 1004
;I '$O(^DPT(DFN,"S",BSDBD)) D Q
;. W !!,"NO APPOINTMENTS FOUND!",!
I '$O(^DPT(DFN,"S",BSDBD)),'$$ONWL^BSDWLV(DFN,"C") D D PAT Q
. W !!,"NO APPOINTMENTS OR WAITING LIST ENTRIES FOUND!",!
;end of PATCH 1004 changes
;
;S BSDED=$$READ^BDGF("D^::EX","Select Ending Date","T+90") Q:'BSDED
S BSDED=$$READ^BDGF("D^::EX","Select Ending Date","T+180") Q:'BSDED ;IHS/OIT/LJF 7/20/2005 PATCH 1004
;
D EN,PAT Q
;
EN ;EP; -- main entry point for SD IHS APPT MADE BY;IHS/ITSC/LJF PATCH 1003
NEW VALMCNT
S VALMCC=1 D TERM^VALM0,CLEAR^VALM1
D EN^VALM("BSDAM DISPLAY APPTS")
D CLEAR^VALM1,EXIT
Q
;
HDR ; -- header code
NEW X
S VALMHDR(1)=$$SP(15)_$$CONF^BDGF
S X=$G(IORVON)_$$GET1^DIQ(2,DFN,.01)_$G(IORVOFF)
S X=$$PAD(X,40)_"#"_$$HRCN^BDGF2(DFN,+$G(DUZ(2)))
S X=$$PAD(X,52)_"DOB: "_$$GET1^DIQ(2,DFN,.03)
S VALMHDR(2)=$$PAD(X,69)_"Sex: "_$E($$GET1^DIQ(2,DFN,.02),1)
I $$DEAD^BDGF2(DFN) S VALMHDR(3)=$$SP(25)_$G(IORVON)_"** Patient Died on "_$$DOD^BDGF2(DFN)_" **"_$G(IORVOFF)
E S VALMHDR(3)=$$PCLINE^SDPPTEM(DFN,DT)
Q
;
INIT ; -- init variables and list array
; variables set are DFN, BSDBD, BSDED
; BSDLN keeps track of line #s to update VALMCNT which is returned
; BSDNUM used to link display line with entry
NEW APDT,NODE,LINE,END,BSDNUM,BSDLN,X,BSDM,BSDU
K ^TMP("BSDDPA",$J)
;
; loop thru pat's appts in date range
S APDT=BSDBD,END=BSDED+.2400
F S APDT=$O(^DPT(DFN,"S",APDT)) Q:'APDT!(APDT>END) D
. S NODE=^DPT(DFN,"S",APDT,0)
. S LINE=$$PAD($$FMTE^XLFDT(APDT),20) ;appt dt
. S LINE=LINE_$$PAD($$GET1^DIQ(44,+NODE,.01),24)_" " ;clinic
. S LINE=LINE_$$STATUS(DFN,APDT,NODE) ;type/status
. S BSDNUM=$G(BSDNUM)+1,LINE=$J(BSDNUM,2)_". "_LINE ;add number
. S X=DFN_U_+NODE_U_APDT D SET(LINE,X,BSDNUM,.BSDLN) ;set line
. D SET($$OI(DFN,+NODE,APDT),"",BSDNUM,.BSDLN) ;other info
. I $P(NODE,U,2)["C",$G(^DPT(DFN,"S",APDT,"R"))]"" D
.. D SET($$SP(15)_"Cancel Remark: "_^DPT(DFN,"S",APDT,"R"),"",BSDNUM,.BSDLN) ;cncl rmark
. D SET(" ","",BSDNUM,.BSDLN) ;blank line
;
;IHS/OIT/LJF 07/20/2005 PATCH 1004 added display of active waiting list entries for patient
K BSDWLR D WLDATA^BSDWLV(DFN,"C",.BSDWLR)
S:'$D(BSDNUM) BSDNUM=0 D SET(" ","",BSDNUM,.BSDLN)
;
I '$O(BSDWLR(0)) D SET($$SP(10)_BSDWLR(0),"",BSDNUM,.BSDLN) I 1
E D
. D SET($$SP(17)_"**** ACTIVE WAIT LIST ENTRIES FOR PATIENT ****","",BSDNUM,.BSDLN)
. D SET(BSDWLR(0),"",BSDNUM,.BSDLN) ;caption line
. D SET($$REPEAT^XLFSTR("-",77),"",BSDNUM,.BSDLN) ;dividing line
. NEW DATE,LINE
. S DATE=0 F S DATE=$O(BSDWLR(DATE)) Q:'DATE D
. . S LINE=0 F S LINE=$O(BSDWLR(DATE,LINE)) Q:'LINE D
. . . D SET($S(LINE=1:"",1:$$SP(3))_$P(BSDWLR(DATE,LINE),U,2),"",BSDNUM,.BSDLN)
. D SET(" ","",BSDNUM,.BSDLN) ;extra line for spacing
;end of PATCH 1004 additions
;
S VALMCNT=+$G(BSDLN)
Q
;
SET(LINE,DATA,NUM,BSDLN) ; -- set ^tmp with display line
S BSDLN=$G(BSDLN)+1
S ^TMP("BSDDPA",$J,BSDLN,0)=LINE
S ^TMP("BSDDPA",$J,"IDX",BSDLN,NUM)=DATA
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K BSDBD,BSDED,BSDLN,BSDNUM
K SDC,SDIFN,SDP,SDPP,SDS,SDSTAT,VALMY,ORX
K VALMBCK,VALMCNT,VALMHDR
D KILL^AUPNPAT
Q
;
;
RETURN ; -- reset variables for return to lt
D TERM^VALM0 S VALMBCK="R" Q
;
GETAPPT(BSDSUB) ; -- select appt from listing
; BSDSUB=subscript of display global
NEW X,Y,Z,BSDA
D FULL^VALM1
S BSDA=""
D EN^VALM2(XQORNOD(0),"OS")
I '$D(VALMY) S BSDSOME=0 Q
S BSDSOME=1
S (SDW,X)=$O(VALMY(0))
S Y=0 F S Y=$O(^TMP(BSDSUB,$J,"IDX",Y)) Q:Y="" Q:BSDA]"" D
. S Z=$O(^TMP(BSDSUB,$J,"IDX",Y,0))
. Q:^TMP(BSDSUB,$J,"IDX",Y,Z)=""
. I Z=X S BSDA=^TMP(BSDSUB,$J,"IDX",Y,Z)
Q:BSDA=""
S DFN=$P(BSDA,U),SDCL=$P(BSDA,U,2),SDT=$P(BSDA,U,3)
Q
;
VA ;EP; called by View Appt action
NEW DFN,SDCL,SDT,SDW
NEW BSDSOME
S SUB=$P(VALMAR,"""",2)
S (DFN,SDCL,SDT)="" D GETAPPT(SUB)
I (DFN="")!(SDCL="")!(SDT="") D D RETURN Q
. Q:'BSDSOME
. W !,"Sorry data missing on this appointment!"
D EN^BSDAMEP
D RETURN
Q
;
VV ;EP; called by View Visit action
NEW DFN,SDCL,SDT,SDW
S SUB=$P(VALMAR,"""",2)
S (DFN,SDCL,SDT)="" D GETAPPT(SUB)
;
I (DFN="")!(SDCL="")!(SDT="") D D RETURN Q
. W !,"Sorry data missing on this appointment!"
. D PAUSE^BDGF
;
S APCDPAT=DFN,APCDVSIT=$$GETVST(DFN,SDT)
I $P($G(^AUPNVSIT(+APCDVSIT,0)),U,5)'=DFN D D RETURN Q
. W !,"Sorry, this appointment does not have a visit attached yet."
. D PAUSE^BDGF
;
D ^APCDVD
K APCDCLN,APCDCAT,APCDDATE,APCDLOC,APCDPAT,APCDVSIT,APCDLOOK,APCDTYPE
D RETURN
Q
;
FINDUSR(PAT,CLINIC,DATE,BSDU,BSDM) ; -- gets user and date made from file 44
NEW X,Y
; look in patient file first
S Y=$P(^DPT(PAT,"S",DATE,0),U,18,19)
I +Y S BSDU=$P(Y,U),BSDM=$P(Y,U,2) D FORMAT Q
;
; if not there, check file 44
K Y S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:(X="")!($D(Y)) D
. I +^SC(CLINIC,"S",DATE,1,X,0)'=DFN Q
. S Y=$P(^SC(CLINIC,"S",DATE,1,X,0),U,6,7)
S BSDU=$P($G(Y),U)
S BSDM=$P($G(Y),U,2)
FORMAT ; -- convert data to external format
S BSDU=$S(BSDU="":"??",1:$$GET1^DIQ(200,BSDU,1))
I $$RESVIEW,'$D(^XUSEC("SDZSUP",DUZ)) S BSDU="" ;who made appt rstrctd
S BSDM=$S(BSDM="":"??",1:$$FMTE^XLFDT(BSDM,"D"))
Q
;
STATUS(PAT,DATE,NODE) ; returns appt status
NEW TYP
S TYP=$$APPTYP^BSDU2(PAT,DATE) ;sched vs. walkin
I $P(NODE,U,2)["C" Q TYP_" - CANCELLED"
I $P(NODE,U,2)'="NT",$P(NODE,U,2)["N" Q TYP_" - NO SHOW"
I $$CO^BSDU2(PAT,+NODE,DATE) Q TYP_" - CHECKED OUT"
I $$CI^BSDU2(PAT,+NODE,DATE) Q TYP_" - CHECKED IN"
Q TYP
;
OI(PAT,CLINIC,DATE) ; -- returns other info display line
Q $$SP(15)_$E($$OI^BSDU2(PAT,CLINIC,DATE),1,65)
;
PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
;
SP(N) ; -- SUBRTN to pad N number of spaces
Q $$PAD(" ",N)
;
RESVIEW() ; -- returns 1 if restrict viewing of who made appt turned on
Q +$$GET1^DIQ(9009020.2,$$DIV^BSDU,.12,"I")
;
GETVST(PAT,DATE) ; returns visit ien for appt date and patient
NEW X
I ('PAT)!('DATE) Q 0
S X=$G(^DPT(PAT,"S",DATE,0)) I 'X Q 0 ;appt node
S X=$P(X,U,20) I 'X Q 0 ;outpt encounter ptr
S X=$G(^SCE(X,0)) I 'X Q 0 ;outpt encounter node
I $P(X,U,2)'=PAT Q 0 ;patient ptr
Q $P(X,U,5) ;visit ptr
BSDDPA ; IHS/ITSC/LJF, WAR - DISPLAY PAT APPTS ; [ 04/16/2004 4:40 PM ]
+1 ;;5.3;PIMS;**1003,1004**;MAY 28, 2004
+2 ;IHS/ITSC/LJF 05/13/2005 PATCH 1003 added EP; to EN subroutine
+3 ;IHS/OIT/LJF 07/20/2005 PATCH 1004 check if patient active on a wait list
+4 ; expanded default end date to 6 months from today
+5 ;
PAT ; -- ask user for patient
+1 NEW DFN,BSDBD,BSDED
+2 DO KILL^AUPNPAT
+3 SET DFN=+$$READ^BDGF("PO^9000001:EQM","Select Patient")
IF DFN<1
QUIT
+4 ;
+5 SET BSDBD=$$READ^BDGF("D^::EX","Select Beginning Date","TODAY")
IF 'BSDBD
QUIT
+6 ;
+7 ;;IHS/OIT/LJF 7/20/2005 PATCH 1004
+8 ;I '$O(^DPT(DFN,"S",BSDBD)) D Q
+9 ;. W !!,"NO APPOINTMENTS FOUND!",!
+10 IF '$ORDER(^DPT(DFN,"S",BSDBD))
IF '$$ONWL^BSDWLV(DFN,"C")
Begin DoDot:1
+11 WRITE !!,"NO APPOINTMENTS OR WAITING LIST ENTRIES FOUND!",!
End DoDot:1
DO PAT
QUIT
+12 ;end of PATCH 1004 changes
+13 ;
+14 ;S BSDED=$$READ^BDGF("D^::EX","Select Ending Date","T+90") Q:'BSDED
+15 ;IHS/OIT/LJF 7/20/2005 PATCH 1004
SET BSDED=$$READ^BDGF("D^::EX","Select Ending Date","T+180")
IF 'BSDED
QUIT
+16 ;
+17 DO EN
DO PAT
QUIT
+18 ;
EN ;EP; -- main entry point for SD IHS APPT MADE BY;IHS/ITSC/LJF PATCH 1003
+1 NEW VALMCNT
+2 SET VALMCC=1
DO TERM^VALM0
DO CLEAR^VALM1
+3 DO EN^VALM("BSDAM DISPLAY APPTS")
+4 DO CLEAR^VALM1
DO EXIT
+5 QUIT
+6 ;
HDR ; -- header code
+1 NEW X
+2 SET VALMHDR(1)=$$SP(15)_$$CONF^BDGF
+3 SET X=$GET(IORVON)_$$GET1^DIQ(2,DFN,.01)_$GET(IORVOFF)
+4 SET X=$$PAD(X,40)_"#"_$$HRCN^BDGF2(DFN,+$GET(DUZ(2)))
+5 SET X=$$PAD(X,52)_"DOB: "_$$GET1^DIQ(2,DFN,.03)
+6 SET VALMHDR(2)=$$PAD(X,69)_"Sex: "_$EXTRACT($$GET1^DIQ(2,DFN,.02),1)
+7 IF $$DEAD^BDGF2(DFN)
SET VALMHDR(3)=$$SP(25)_$GET(IORVON)_"** Patient Died on "_$$DOD^BDGF2(DFN)_" **"_$GET(IORVOFF)
+8 IF '$TEST
SET VALMHDR(3)=$$PCLINE^SDPPTEM(DFN,DT)
+9 QUIT
+10 ;
INIT ; -- init variables and list array
+1 ; variables set are DFN, BSDBD, BSDED
+2 ; BSDLN keeps track of line #s to update VALMCNT which is returned
+3 ; BSDNUM used to link display line with entry
+4 NEW APDT,NODE,LINE,END,BSDNUM,BSDLN,X,BSDM,BSDU
+5 KILL ^TMP("BSDDPA",$JOB)
+6 ;
+7 ; loop thru pat's appts in date range
+8 SET APDT=BSDBD
SET END=BSDED+.2400
+9 FOR
SET APDT=$ORDER(^DPT(DFN,"S",APDT))
IF 'APDT!(APDT>END)
QUIT
Begin DoDot:1
+10 SET NODE=^DPT(DFN,"S",APDT,0)
+11 ;appt dt
SET LINE=$$PAD($$FMTE^XLFDT(APDT),20)
+12 ;clinic
SET LINE=LINE_$$PAD($$GET1^DIQ(44,+NODE,.01),24)_" "
+13 ;type/status
SET LINE=LINE_$$STATUS(DFN,APDT,NODE)
+14 ;add number
SET BSDNUM=$GET(BSDNUM)+1
SET LINE=$JUSTIFY(BSDNUM,2)_". "_LINE
+15 ;set line
SET X=DFN_U_+NODE_U_APDT
DO SET(LINE,X,BSDNUM,.BSDLN)
+16 ;other info
DO SET($$OI(DFN,+NODE,APDT),"",BSDNUM,.BSDLN)
+17 IF $PIECE(NODE,U,2)["C"
IF $GET(^DPT(DFN,"S",APDT,"R"))]""
Begin DoDot:2
+18 ;cncl rmark
DO SET($$SP(15)_"Cancel Remark: "_^DPT(DFN,"S",APDT,"R"),"",BSDNUM,.BSDLN)
End DoDot:2
+19 ;blank line
DO SET(" ","",BSDNUM,.BSDLN)
End DoDot:1
+20 ;
+21 ;IHS/OIT/LJF 07/20/2005 PATCH 1004 added display of active waiting list entries for patient
+22 KILL BSDWLR
DO WLDATA^BSDWLV(DFN,"C",.BSDWLR)
+23 IF '$DATA(BSDNUM)
SET BSDNUM=0
DO SET(" ","",BSDNUM,.BSDLN)
+24 ;
+25 IF '$ORDER(BSDWLR(0))
DO SET($$SP(10)_BSDWLR(0),"",BSDNUM,.BSDLN)
IF 1
+26 IF '$TEST
Begin DoDot:1
+27 DO SET($$SP(17)_"**** ACTIVE WAIT LIST ENTRIES FOR PATIENT ****","",BSDNUM,.BSDLN)
+28 ;caption line
DO SET(BSDWLR(0),"",BSDNUM,.BSDLN)
+29 ;dividing line
DO SET($$REPEAT^XLFSTR("-",77),"",BSDNUM,.BSDLN)
+30 NEW DATE,LINE
+31 SET DATE=0
FOR
SET DATE=$ORDER(BSDWLR(DATE))
IF 'DATE
QUIT
Begin DoDot:2
+32 SET LINE=0
FOR
SET LINE=$ORDER(BSDWLR(DATE,LINE))
IF 'LINE
QUIT
Begin DoDot:3
+33 DO SET($SELECT(LINE=1:"",1:$$SP(3))_$PIECE(BSDWLR(DATE,LINE),U,2),"",BSDNUM,.BSDLN)
End DoDot:3
End DoDot:2
+34 ;extra line for spacing
DO SET(" ","",BSDNUM,.BSDLN)
End DoDot:1
+35 ;end of PATCH 1004 additions
+36 ;
+37 SET VALMCNT=+$GET(BSDLN)
+38 QUIT
+39 ;
SET(LINE,DATA,NUM,BSDLN) ; -- set ^tmp with display line
+1 SET BSDLN=$GET(BSDLN)+1
+2 SET ^TMP("BSDDPA",$JOB,BSDLN,0)=LINE
+3 SET ^TMP("BSDDPA",$JOB,"IDX",BSDLN,NUM)=DATA
+4 QUIT
+5 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL BSDBD,BSDED,BSDLN,BSDNUM
+2 KILL SDC,SDIFN,SDP,SDPP,SDS,SDSTAT,VALMY,ORX
+3 KILL VALMBCK,VALMCNT,VALMHDR
+4 DO KILL^AUPNPAT
+5 QUIT
+6 ;
+7 ;
RETURN ; -- reset variables for return to lt
+1 DO TERM^VALM0
SET VALMBCK="R"
QUIT
+2 ;
GETAPPT(BSDSUB) ; -- select appt from listing
+1 ; BSDSUB=subscript of display global
+2 NEW X,Y,Z,BSDA
+3 DO FULL^VALM1
+4 SET BSDA=""
+5 DO EN^VALM2(XQORNOD(0),"OS")
+6 IF '$DATA(VALMY)
SET BSDSOME=0
QUIT
+7 SET BSDSOME=1
+8 SET (SDW,X)=$ORDER(VALMY(0))
+9 SET Y=0
FOR
SET Y=$ORDER(^TMP(BSDSUB,$JOB,"IDX",Y))
IF Y=""
QUIT
IF BSDA]""
QUIT
Begin DoDot:1
+10 SET Z=$ORDER(^TMP(BSDSUB,$JOB,"IDX",Y,0))
+11 IF ^TMP(BSDSUB,$JOB,"IDX",Y,Z)=""
QUIT
+12 IF Z=X
SET BSDA=^TMP(BSDSUB,$JOB,"IDX",Y,Z)
End DoDot:1
+13 IF BSDA=""
QUIT
+14 SET DFN=$PIECE(BSDA,U)
SET SDCL=$PIECE(BSDA,U,2)
SET SDT=$PIECE(BSDA,U,3)
+15 QUIT
+16 ;
VA ;EP; called by View Appt action
+1 NEW DFN,SDCL,SDT,SDW
+2 NEW BSDSOME
+3 SET SUB=$PIECE(VALMAR,"""",2)
+4 SET (DFN,SDCL,SDT)=""
DO GETAPPT(SUB)
+5 IF (DFN="")!(SDCL="")!(SDT="")
Begin DoDot:1
+6 IF 'BSDSOME
QUIT
+7 WRITE !,"Sorry data missing on this appointment!"
End DoDot:1
DO RETURN
QUIT
+8 DO EN^BSDAMEP
+9 DO RETURN
+10 QUIT
+11 ;
VV ;EP; called by View Visit action
+1 NEW DFN,SDCL,SDT,SDW
+2 SET SUB=$PIECE(VALMAR,"""",2)
+3 SET (DFN,SDCL,SDT)=""
DO GETAPPT(SUB)
+4 ;
+5 IF (DFN="")!(SDCL="")!(SDT="")
Begin DoDot:1
+6 WRITE !,"Sorry data missing on this appointment!"
+7 DO PAUSE^BDGF
End DoDot:1
DO RETURN
QUIT
+8 ;
+9 SET APCDPAT=DFN
SET APCDVSIT=$$GETVST(DFN,SDT)
+10 IF $PIECE($GET(^AUPNVSIT(+APCDVSIT,0)),U,5)'=DFN
Begin DoDot:1
+11 WRITE !,"Sorry, this appointment does not have a visit attached yet."
+12 DO PAUSE^BDGF
End DoDot:1
DO RETURN
QUIT
+13 ;
+14 DO ^APCDVD
+15 KILL APCDCLN,APCDCAT,APCDDATE,APCDLOC,APCDPAT,APCDVSIT,APCDLOOK,APCDTYPE
+16 DO RETURN
+17 QUIT
+18 ;
FINDUSR(PAT,CLINIC,DATE,BSDU,BSDM) ; -- gets user and date made from file 44
+1 NEW X,Y
+2 ; look in patient file first
+3 SET Y=$PIECE(^DPT(PAT,"S",DATE,0),U,18,19)
+4 IF +Y
SET BSDU=$PIECE(Y,U)
SET BSDM=$PIECE(Y,U,2)
DO FORMAT
QUIT
+5 ;
+6 ; if not there, check file 44
+7 KILL Y
SET X=0
FOR
SET X=$ORDER(^SC(CLINIC,"S",DATE,1,X))
IF (X="")!($DATA(Y))
QUIT
Begin DoDot:1
+8 IF +^SC(CLINIC,"S",DATE,1,X,0)'=DFN
QUIT
+9 SET Y=$PIECE(^SC(CLINIC,"S",DATE,1,X,0),U,6,7)
End DoDot:1
+10 SET BSDU=$PIECE($GET(Y),U)
+11 SET BSDM=$PIECE($GET(Y),U,2)
FORMAT ; -- convert data to external format
+1 SET BSDU=$SELECT(BSDU="":"??",1:$$GET1^DIQ(200,BSDU,1))
+2 ;who made appt rstrctd
IF $$RESVIEW
IF '$DATA(^XUSEC("SDZSUP",DUZ))
SET BSDU=""
+3 SET BSDM=$SELECT(BSDM="":"??",1:$$FMTE^XLFDT(BSDM,"D"))
+4 QUIT
+5 ;
STATUS(PAT,DATE,NODE) ; returns appt status
+1 NEW TYP
+2 ;sched vs. walkin
SET TYP=$$APPTYP^BSDU2(PAT,DATE)
+3 IF $PIECE(NODE,U,2)["C"
QUIT TYP_" - CANCELLED"
+4 IF $PIECE(NODE,U,2)'="NT"
IF $PIECE(NODE,U,2)["N"
QUIT TYP_" - NO SHOW"
+5 IF $$CO^BSDU2(PAT,+NODE,DATE)
QUIT TYP_" - CHECKED OUT"
+6 IF $$CI^BSDU2(PAT,+NODE,DATE)
QUIT TYP_" - CHECKED IN"
+7 QUIT TYP
+8 ;
OI(PAT,CLINIC,DATE) ; -- returns other info display line
+1 QUIT $$SP(15)_$EXTRACT($$OI^BSDU2(PAT,CLINIC,DATE),1,65)
+2 ;
PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
+1 QUIT $EXTRACT(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
+2 ;
SP(N) ; -- SUBRTN to pad N number of spaces
+1 QUIT $$PAD(" ",N)
+2 ;
RESVIEW() ; -- returns 1 if restrict viewing of who made appt turned on
+1 QUIT +$$GET1^DIQ(9009020.2,$$DIV^BSDU,.12,"I")
+2 ;
GETVST(PAT,DATE) ; returns visit ien for appt date and patient
+1 NEW X
+2 IF ('PAT)!('DATE)
QUIT 0
+3 ;appt node
SET X=$GET(^DPT(PAT,"S",DATE,0))
IF 'X
QUIT 0
+4 ;outpt encounter ptr
SET X=$PIECE(X,U,20)
IF 'X
QUIT 0
+5 ;outpt encounter node
SET X=$GET(^SCE(X,0))
IF 'X
QUIT 0
+6 ;patient ptr
IF $PIECE(X,U,2)'=PAT
QUIT 0
+7 ;visit ptr
QUIT $PIECE(X,U,5)
