BDGSVL1 ; IHS/ANMC/LJF - SCHED VISIT LISTING ;
;;5.3;PIMS;;APR 26, 2002
;
EN ; -- main entry point for BDG SCHED VISITS
I $E(IOST,1,2)'="C-" D INIT,PRINT Q
NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
D EN^VALM("BDG SCHED VISITS")
D CLEAR^VALM1
Q
;
HDR ; -- header code
NEW X
S VALMHDR(1)=$$SP(15)_$$CONF^BDGF
S X="For "_$$FMTE^XLFDT(BDGBD)_" to "_$$FMTE^XLFDT(BDGED)
S VALMHDR(2)=$$SP(79-$L(X)\2)_X
S X="Scheduled "_$S(BDGVT="A":"Admissions",BDGVT="D":"Day Surgeries",BDGVT="O":"Outpatient Visits",1:"Visits - All Types")
S X=X_" (Sorted by "_$P(BDGS1,U,2)_" & "_$P(BDGS2,U,2)_")"
S VALMHDR(3)=$$SP(79-$L(X)\2)_X
;
S X="CAP"_BDGRT D @X ;set up captions based on type for report
;
S VALMSG=$$SP(5)_"Authorizing Provider/Case Mgr/Referred By"
Q
;
INIT ; -- init variables and list array
NEW DATE,END,BDGN,TYPE,SORT1,SORT2,X
K ^TMP("BDGSVL",$J),^TMP("BDGSVL1",$J)
S VALMCNT=0
;
S DATE=BDGBD-.0001,END=BDGED+.24
F S DATE=$O(^BDGSV("D",DATE)) Q:'DATE Q:(DATE>END) D
. S BDGN=0
. F S BDGN=$O(^BDGSV("D",DATE,BDGN)) Q:'BDGN D
.. ;
.. S TYPE=$$GET1^DIQ(9009016.7,BDGN,.03,"I")
.. I (BDGVT'=4),(BDGVT'=TYPE) Q ;not type selected
.. ;
.. ; screen out no-shows, cancels and errors if asked to
.. I 'BDGEX S X=$$GET1^DIQ(9009016.7,BDGN,.16,"I") I X]"",X'="PA" Q
.. ;
.. S SORT1=$$GET1^DIQ(9009016.7,BDGN,+BDGS1)
.. I SORT1="" S X=$P($P(BDGS1,U),";",2) I X S SORT1=$$GET1^DIQ(9009016.7,BDGN,X) ;if other fields can be used (i.e. service)
.. I SORT1="" S SORT1="??"
.. ;
.. S SORT2=$$GET1^DIQ(9009016.7,BDGN,+BDGS2)
.. I SORT2="" S X=$P($P(BDGS2,U),";",2) I X S SORT2=$$GET1^DIQ(9009016.7,BDGN,X) ;if other fields can be used (i.e. service)
.. I SORT2="" S SORT2="??"
.. ;
.. ; build sorted list
.. S ^TMP("BDGSVL1",$J,SORT1,SORT2,BDGN)=""
;
; now take sorted list and build display (detailed or brief)
S SORT1=0
F S SORT1=$O(^TMP("BDGSVL1",$J,SORT1)) Q:SORT1="" D
. S SORT2=0
. F S SORT2=$O(^TMP("BDGSVL1",$J,SORT1,SORT2)) Q:SORT2="" D
.. S BDGN=0
.. F S BDGN=$O(^TMP("BDGSVL1",$J,SORT1,SORT2,BDGN)) Q:'BDGN D
... I BDGRT="D" D DETAIL(BDGN) Q
... I BDGRT="B" D BRIEF(BDGN)
;
I '$D(^TMP("BDGSVL",$J)) D SET("No data found",.VALMCNT)
K ^TMP("BDGSVL1",$J)
Q
;
DETAIL(IEN) ;build detailed display
NEW LINE,X
S LINE=$E($$GET1^DIQ(9009016.7,IEN,.01),1,18) ;patient
S LINE=$$PAD(LINE,20)_$J($$GET1^DIQ(9009016.7,IEN,.011),6) ;chart #
S LINE=$$PAD(LINE,28)_$$GET1^DIQ(9009016.7,IEN,.012) ;age
S LINE=$$PAD(LINE,33)_$$GET1^DIQ(2,+$G(^BDGSV(IEN,0)),.02,"I") ;sex
S LINE=$$PAD(LINE,36)_$$GET1^DIQ(9009016.7,IEN,.02) ;date
S LINE=$$PAD(LINE,49)_$$VSTTYPE(IEN) ;vst type
S X=$$GET1^DIQ(9009016.7,IEN,.16) I X="" S X="OPEN/PENDING"
S LINE=$$PAD($$PAD(LINE,54)_X,67) ;disposition
S LINE=LINE_$$GET1^DIQ(9009016.7,IEN,.013) ;community
D SET(LINE,.VALMCNT)
;
S LINE=$$SP(5)_$$LOC(IEN) ;location
S LINE=$$PAD(LINE,14)_$$SRV(IEN) ;service
S LINE=$$PAD(LINE,21)_"LOS:"_$$GET1^DIQ(9009016.7,IEN,.13) ;expctd los
S LINE=$$PAD(LINE,27)_$E($$GET1^DIQ(9009016.7,IEN,.04),1,18) ;prov
S LINE=LINE_"/"_$E($$GET1^DIQ(9009016.7,IEN,.05),1,18) ;case mgr
S LINE=LINE_"/"_$E($$GET1^DIQ(9009016.7,IEN,.06),1,18) ;ref prov
D SET(LINE,.VALMCNT)
;
S LINE=$$SP(5)_"Dx: "_$$GET1^DIQ(9009016.7,IEN,201) ;diagnosis
S X=$$GET1^DIQ(9009016.7,IEN,101,"I")
I X]"" S LINE=$$PAD(LINE,58)_" TRVL:"_X ;travel
S LINE=LINE_" "_$$HOUSING(IEN) ;housing
D SET(LINE,.VALMCNT)
;
S X=$$GET1^DIQ(9009016.7,IEN,202) I X]"" D ;procedure, if any
. S LINE=$$PAD($$SP(5)_X,53)_"Scheduled for "
. S LINE=LINE_$$GET1^DIQ(9009016.7,IEN,.14)
. D SET(LINE,.VALMCNT)
;
S X=$$GET1^DIQ(9009016.7,IEN,102),Y=$$GET1^DIQ(9009016.7,IEN,106)
I (X]"")!(Y]"") D ;travel details or escort info
. S LINE=$$SP(5)_$S(X]"":X_" "_Y,1:Y)
. S LINE=$$PAD(LINE,$L(LINE)+2)_$$ESCORT(IEN)
. D SET(LINE,.VALMCNT)
;
; other comments
S X=$$GET1^DIQ(9009016.7,IEN,203) I X]"" D SET($$SP(5)_X,.VALMCNT)
D SET("",.VALMCNT) ;blank line between patients
;
Q
;
BRIEF(IEN) ;build brief display
NEW LINE,X,Y,Z
S LINE=$E($$GET1^DIQ(9009016.7,IEN,.01),1,18) ;patient
S LINE=$$PAD(LINE,20)_$J($$GET1^DIQ(9009016.7,IEN,.011),6) ;chart #
S LINE=$$PAD(LINE,28)_$$GET1^DIQ(9009016.7,IEN,.02) ;date
S LINE=$$PAD(LINE,41)_$$VSTTYPE(IEN) ;vst type
S LINE=$$PAD(LINE,46)_$$LOC(IEN) ;location
S LINE=$$PAD(LINE,55)_$$SRV(IEN) ;service
S LINE=$$PAD(LINE,61)_$$GET1^DIQ(9009016.7,IEN,.04) ;provider
D SET(LINE,.VALMCNT)
;
S LINE=$$SP(5)_"("_$E($$GET1^DIQ(9009016.7,IEN,.013),1,20) ;community
S X=$$GET1^DIQ(9009016.7,IEN,.16) I X="" S X="OPEN/PENDING"
S LINE=$$PAD($$PAD(LINE,28)_X,40) ;disposition
;
S LINE=LINE_" TRVL:"_$$GET1^DIQ(9009016.7,IEN,101,"I") ;travel
S LINE=$$PAD(LINE,50)_$$HOUSING(IEN) ;housing
;
;
S LINE=$$PAD(LINE,65)_$$GET1^DIQ(9009016.7,IEN,.06)_")" ;ref prov
D SET(LINE,.VALMCNT)
D SET("",.VALMCNT) ;blank line between patients
Q
;
SET(DATA,NUM) ; put display line into array
S NUM=NUM+1
S ^TMP("BDGSVL",$J,NUM,0)=DATA
Q
;
CAPB ; set up brief caption
S VALMCAP=$$PAD(" Patient/Community",20)_"Chart# Expected On Type"
S VALMCAP=$$PAD(VALMCAP_" Ward/Cln Srv Provider/Referring",79)
Q
;
CAPD ; set up detailed caption
S VALMCAP=$$PAD(" Patient",20)_"Chart# Age Sex Expected On Type"
S VALMCAP=$$PAD(VALMCAP_" Status Community",79)
Q
;
PRINT ; print report to paper
U IO D HDG
NEW LINE
S LINE=0 F S LINE=$O(^TMP("BSDSVL",$J,LINE)) Q:'LINE D
. I $Y>(IOSL-4) D HDG
. W !,^TMP("BSDSVL",$J,LINE,0)
D ^%ZISC,EXIT
Q
;
HDG ; heading for paper report
D HDR W @IOF,?30,"Scheduled Visit Listing"
NEW I F I=1:1 Q:'$D(VALMHDR(I)) W !,VALMHDR(I)
W !,$$REPEAT^XLFSTR("=",80)
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("BDGSVL",$J)
K BDGBD,BDGED,BDGVT,BDGEX,BDGS1,BDGS2,BDGRT
Q
;
EXPND ; -- expand code
Q
;
PAD(D,L) ;EP -- SUBRTN to pad length of data
; -- D=data L=length
Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
;
SP(N) ; -- SUBRTN to pad N number of spaces
Q $$PAD(" ",N)
;
VSTTYPE(N) ; returns printable abbreviated visit type
NEW X,Y,Z
S X=$$GET1^DIQ(9009016.7,N,.03,"I") ;visit type
S Y=$$GET1^DIQ(9009016.7,N,.17) ;observation?
S Z=$$GET1^DIQ(9009016.7,N,.15) ;same day admit?
Q $S(X="O":"OPT",Y="YES":"DSO",Z="YES":"SDA",X="A":"INP",X="D":"DS",1:"")
;
LOC(N) ; return hospital location (ward or clinic)
NEW X,Y
; get ward abbreviation
S X=$$GET1^DIQ(9009016.7,N,.09,"I")
I X S X=$$GET1^DIQ(9009016.5,X,.02)
; get clinic abbreviation
S Y=$$GET1^DIQ(9009016.7,N,.11,"I") I Y S Y=$$GET1^DIQ(44,Y,1)
; set location (ward or clinic or "" if day surgery)
Q $S(X]"":X,Y]"":Y,BDGVT="D":"",1:"Loc ??")
;
SRV(N) ; return service (treating specialty or surgical service)
NEW X,Y,Z
S X=$$GET1^DIQ(9009016.7,N,.08,"I") I X S X=$$GET1^DIQ(45.7,X,99)
S Y=$E($$GET1^DIQ(9009016.7,N,.121),1,5)
S Z=$$GET1^DIQ(9009016.7,N,.03,"I") ;visit type
Q $S(X]"":X,Y]"":Y,Z="O":"",1:"Srv ??")
;
HOUSING(N) ; returns brief summary of housing data
NEW X,Y
S X=$$GET1^DIQ(9009016.7,IEN,103,"I") I X="" Q "" ;housing authorized?
S Y=$$GET1^DIQ(9009016.7,IEN,104) ;# of days
S Z=$$GET1^DIQ(9009016.7,IEN,105,"I") ;housing status
Q "HOUS:"_X_$S(Y]"":"x"_Y,1:"")_$S(Z]"":"("_Z_")",1:"")
;
ESCORT(N) ; return summary of escort info
NEW X,Y
S X=$$GET1^DIQ(9009016.7,N,107,"I") I X]"" S X="TRVL:"_X
S Y=$$GET1^DIQ(9009016.7,N,108),Y1=$$GET1^DIQ(9009016.7,N,109)
S Y2=$$GET1^DIQ(9009016.7,N,110)
I Y]"" S Y="HOUS:"_Y_$S(Y1]"":"x"_Y1,1:"")_$S(Y2]"":"("_Y2_")",1:"")
Q X_" "_Y_" "_$$GET1^DIQ(9009016.7,N,111)
BDGSVL1 ; IHS/ANMC/LJF - SCHED VISIT LISTING ;
+1 ;;5.3;PIMS;;APR 26, 2002
+2 ;
EN ; -- main entry point for BDG SCHED VISITS
+1 IF $EXTRACT(IOST,1,2)'="C-"
DO INIT
DO PRINT
QUIT
+2 NEW VALMCNT
DO TERM^VALM0
DO CLEAR^VALM1
+3 DO EN^VALM("BDG SCHED VISITS")
+4 DO CLEAR^VALM1
+5 QUIT
+6 ;
HDR ; -- header code
+1 NEW X
+2 SET VALMHDR(1)=$$SP(15)_$$CONF^BDGF
+3 SET X="For "_$$FMTE^XLFDT(BDGBD)_" to "_$$FMTE^XLFDT(BDGED)
+4 SET VALMHDR(2)=$$SP(79-$LENGTH(X)\2)_X
+5 SET X="Scheduled "_$SELECT(BDGVT="A":"Admissions",BDGVT="D":"Day Surgeries",BDGVT="O":"Outpatient Visits",1:"Visits - All Types")
+6 SET X=X_" (Sorted by "_$PIECE(BDGS1,U,2)_" & "_$PIECE(BDGS2,U,2)_")"
+7 SET VALMHDR(3)=$$SP(79-$LENGTH(X)\2)_X
+8 ;
+9 ;set up captions based on type for report
SET X="CAP"_BDGRT
DO @X
+10 ;
+11 SET VALMSG=$$SP(5)_"Authorizing Provider/Case Mgr/Referred By"
+12 QUIT
+13 ;
INIT ; -- init variables and list array
+1 NEW DATE,END,BDGN,TYPE,SORT1,SORT2,X
+2 KILL ^TMP("BDGSVL",$JOB),^TMP("BDGSVL1",$JOB)
+3 SET VALMCNT=0
+4 ;
+5 SET DATE=BDGBD-.0001
SET END=BDGED+.24
+6 FOR
SET DATE=$ORDER(^BDGSV("D",DATE))
IF 'DATE
QUIT
IF (DATE>END)
QUIT
Begin DoDot:1
+7 SET BDGN=0
+8 FOR
SET BDGN=$ORDER(^BDGSV("D",DATE,BDGN))
IF 'BDGN
QUIT
Begin DoDot:2
+9 ;
+10 SET TYPE=$$GET1^DIQ(9009016.7,BDGN,.03,"I")
+11 ;not type selected
IF (BDGVT'=4)
IF (BDGVT'=TYPE)
QUIT
+12 ;
+13 ; screen out no-shows, cancels and errors if asked to
+14 IF 'BDGEX
SET X=$$GET1^DIQ(9009016.7,BDGN,.16,"I")
IF X]""
IF X'="PA"
QUIT
+15 ;
+16 SET SORT1=$$GET1^DIQ(9009016.7,BDGN,+BDGS1)
+17 ;if other fields can be used (i.e. service)
IF SORT1=""
SET X=$PIECE($PIECE(BDGS1,U),";",2)
IF X
SET SORT1=$$GET1^DIQ(9009016.7,BDGN,X)
+18 IF SORT1=""
SET SORT1="??"
+19 ;
+20 SET SORT2=$$GET1^DIQ(9009016.7,BDGN,+BDGS2)
+21 ;if other fields can be used (i.e. service)
IF SORT2=""
SET X=$PIECE($PIECE(BDGS2,U),";",2)
IF X
SET SORT2=$$GET1^DIQ(9009016.7,BDGN,X)
+22 IF SORT2=""
SET SORT2="??"
+23 ;
+24 ; build sorted list
+25 SET ^TMP("BDGSVL1",$JOB,SORT1,SORT2,BDGN)=""
End DoDot:2
End DoDot:1
+26 ;
+27 ; now take sorted list and build display (detailed or brief)
+28 SET SORT1=0
+29 FOR
SET SORT1=$ORDER(^TMP("BDGSVL1",$JOB,SORT1))
IF SORT1=""
QUIT
Begin DoDot:1
+30 SET SORT2=0
+31 FOR
SET SORT2=$ORDER(^TMP("BDGSVL1",$JOB,SORT1,SORT2))
IF SORT2=""
QUIT
Begin DoDot:2
+32 SET BDGN=0
+33 FOR
SET BDGN=$ORDER(^TMP("BDGSVL1",$JOB,SORT1,SORT2,BDGN))
IF 'BDGN
QUIT
Begin DoDot:3
+34 IF BDGRT="D"
DO DETAIL(BDGN)
QUIT
+35 IF BDGRT="B"
DO BRIEF(BDGN)
End DoDot:3
End DoDot:2
End DoDot:1
+36 ;
+37 IF '$DATA(^TMP("BDGSVL",$JOB))
DO SET("No data found",.VALMCNT)
+38 KILL ^TMP("BDGSVL1",$JOB)
+39 QUIT
+40 ;
DETAIL(IEN) ;build detailed display
+1 NEW LINE,X
+2 ;patient
SET LINE=$EXTRACT($$GET1^DIQ(9009016.7,IEN,.01),1,18)
+3 ;chart #
SET LINE=$$PAD(LINE,20)_$JUSTIFY($$GET1^DIQ(9009016.7,IEN,.011),6)
+4 ;age
SET LINE=$$PAD(LINE,28)_$$GET1^DIQ(9009016.7,IEN,.012)
+5 ;sex
SET LINE=$$PAD(LINE,33)_$$GET1^DIQ(2,+$GET(^BDGSV(IEN,0)),.02,"I")
+6 ;date
SET LINE=$$PAD(LINE,36)_$$GET1^DIQ(9009016.7,IEN,.02)
+7 ;vst type
SET LINE=$$PAD(LINE,49)_$$VSTTYPE(IEN)
+8 SET X=$$GET1^DIQ(9009016.7,IEN,.16)
IF X=""
SET X="OPEN/PENDING"
+9 ;disposition
SET LINE=$$PAD($$PAD(LINE,54)_X,67)
+10 ;community
SET LINE=LINE_$$GET1^DIQ(9009016.7,IEN,.013)
+11 DO SET(LINE,.VALMCNT)
+12 ;
+13 ;location
SET LINE=$$SP(5)_$$LOC(IEN)
+14 ;service
SET LINE=$$PAD(LINE,14)_$$SRV(IEN)
+15 ;expctd los
SET LINE=$$PAD(LINE,21)_"LOS:"_$$GET1^DIQ(9009016.7,IEN,.13)
+16 ;prov
SET LINE=$$PAD(LINE,27)_$EXTRACT($$GET1^DIQ(9009016.7,IEN,.04),1,18)
+17 ;case mgr
SET LINE=LINE_"/"_$EXTRACT($$GET1^DIQ(9009016.7,IEN,.05),1,18)
+18 ;ref prov
SET LINE=LINE_"/"_$EXTRACT($$GET1^DIQ(9009016.7,IEN,.06),1,18)
+19 DO SET(LINE,.VALMCNT)
+20 ;
+21 ;diagnosis
SET LINE=$$SP(5)_"Dx: "_$$GET1^DIQ(9009016.7,IEN,201)
+22 SET X=$$GET1^DIQ(9009016.7,IEN,101,"I")
+23 ;travel
IF X]""
SET LINE=$$PAD(LINE,58)_" TRVL:"_X
+24 ;housing
SET LINE=LINE_" "_$$HOUSING(IEN)
+25 DO SET(LINE,.VALMCNT)
+26 ;
+27 ;procedure, if any
SET X=$$GET1^DIQ(9009016.7,IEN,202)
IF X]""
Begin DoDot:1
+28 SET LINE=$$PAD($$SP(5)_X,53)_"Scheduled for "
+29 SET LINE=LINE_$$GET1^DIQ(9009016.7,IEN,.14)
+30 DO SET(LINE,.VALMCNT)
End DoDot:1
+31 ;
+32 SET X=$$GET1^DIQ(9009016.7,IEN,102)
SET Y=$$GET1^DIQ(9009016.7,IEN,106)
+33 ;travel details or escort info
IF (X]"")!(Y]"")
Begin DoDot:1
+34 SET LINE=$$SP(5)_$SELECT(X]"":X_" "_Y,1:Y)
+35 SET LINE=$$PAD(LINE,$LENGTH(LINE)+2)_$$ESCORT(IEN)
+36 DO SET(LINE,.VALMCNT)
End DoDot:1
+37 ;
+38 ; other comments
+39 SET X=$$GET1^DIQ(9009016.7,IEN,203)
IF X]""
DO SET($$SP(5)_X,.VALMCNT)
+40 ;blank line between patients
DO SET("",.VALMCNT)
+41 ;
+42 QUIT
+43 ;
BRIEF(IEN) ;build brief display
+1 NEW LINE,X,Y,Z
+2 ;patient
SET LINE=$EXTRACT($$GET1^DIQ(9009016.7,IEN,.01),1,18)
+3 ;chart #
SET LINE=$$PAD(LINE,20)_$JUSTIFY($$GET1^DIQ(9009016.7,IEN,.011),6)
+4 ;date
SET LINE=$$PAD(LINE,28)_$$GET1^DIQ(9009016.7,IEN,.02)
+5 ;vst type
SET LINE=$$PAD(LINE,41)_$$VSTTYPE(IEN)
+6 ;location
SET LINE=$$PAD(LINE,46)_$$LOC(IEN)
+7 ;service
SET LINE=$$PAD(LINE,55)_$$SRV(IEN)
+8 ;provider
SET LINE=$$PAD(LINE,61)_$$GET1^DIQ(9009016.7,IEN,.04)
+9 DO SET(LINE,.VALMCNT)
+10 ;
+11 ;community
SET LINE=$$SP(5)_"("_$EXTRACT($$GET1^DIQ(9009016.7,IEN,.013),1,20)
+12 SET X=$$GET1^DIQ(9009016.7,IEN,.16)
IF X=""
SET X="OPEN/PENDING"
+13 ;disposition
SET LINE=$$PAD($$PAD(LINE,28)_X,40)
+14 ;
+15 ;travel
SET LINE=LINE_" TRVL:"_$$GET1^DIQ(9009016.7,IEN,101,"I")
+16 ;housing
SET LINE=$$PAD(LINE,50)_$$HOUSING(IEN)
+17 ;
+18 ;
+19 ;ref prov
SET LINE=$$PAD(LINE,65)_$$GET1^DIQ(9009016.7,IEN,.06)_")"
+20 DO SET(LINE,.VALMCNT)
+21 ;blank line between patients
DO SET("",.VALMCNT)
+22 QUIT
+23 ;
SET(DATA,NUM) ; put display line into array
+1 SET NUM=NUM+1
+2 SET ^TMP("BDGSVL",$JOB,NUM,0)=DATA
+3 QUIT
+4 ;
CAPB ; set up brief caption
+1 SET VALMCAP=$$PAD(" Patient/Community",20)_"Chart# Expected On Type"
+2 SET VALMCAP=$$PAD(VALMCAP_" Ward/Cln Srv Provider/Referring",79)
+3 QUIT
+4 ;
CAPD ; set up detailed caption
+1 SET VALMCAP=$$PAD(" Patient",20)_"Chart# Age Sex Expected On Type"
+2 SET VALMCAP=$$PAD(VALMCAP_" Status Community",79)
+3 QUIT
+4 ;
PRINT ; print report to paper
+1 USE IO
DO HDG
+2 NEW LINE
+3 SET LINE=0
FOR
SET LINE=$ORDER(^TMP("BSDSVL",$JOB,LINE))
IF 'LINE
QUIT
Begin DoDot:1
+4 IF $Y>(IOSL-4)
DO HDG
+5 WRITE !,^TMP("BSDSVL",$JOB,LINE,0)
End DoDot:1
+6 DO ^%ZISC
DO EXIT
+7 QUIT
+8 ;
HDG ; heading for paper report
+1 DO HDR
WRITE @IOF,?30,"Scheduled Visit Listing"
+2 NEW I
FOR I=1:1
IF '$DATA(VALMHDR(I))
QUIT
WRITE !,VALMHDR(I)
+3 WRITE !,$$REPEAT^XLFSTR("=",80)
+4 QUIT
+5 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("BDGSVL",$JOB)
+2 KILL BDGBD,BDGED,BDGVT,BDGEX,BDGS1,BDGS2,BDGRT
+3 QUIT
+4 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
PAD(D,L) ;EP -- SUBRTN to pad length of data
+1 ; -- D=data L=length
+2 QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)
+3 ;
SP(N) ; -- SUBRTN to pad N number of spaces
+1 QUIT $$PAD(" ",N)
+2 ;
VSTTYPE(N) ; returns printable abbreviated visit type
+1 NEW X,Y,Z
+2 ;visit type
SET X=$$GET1^DIQ(9009016.7,N,.03,"I")
+3 ;observation?
SET Y=$$GET1^DIQ(9009016.7,N,.17)
+4 ;same day admit?
SET Z=$$GET1^DIQ(9009016.7,N,.15)
+5 QUIT $SELECT(X="O":"OPT",Y="YES":"DSO",Z="YES":"SDA",X="A":"INP",X="D":"DS",1:"")
+6 ;
LOC(N) ; return hospital location (ward or clinic)
+1 NEW X,Y
+2 ; get ward abbreviation
+3 SET X=$$GET1^DIQ(9009016.7,N,.09,"I")
+4 IF X
SET X=$$GET1^DIQ(9009016.5,X,.02)
+5 ; get clinic abbreviation
+6 SET Y=$$GET1^DIQ(9009016.7,N,.11,"I")
IF Y
SET Y=$$GET1^DIQ(44,Y,1)
+7 ; set location (ward or clinic or "" if day surgery)
+8 QUIT $SELECT(X]"":X,Y]"":Y,BDGVT="D":"",1:"Loc ??")
+9 ;
SRV(N) ; return service (treating specialty or surgical service)
+1 NEW X,Y,Z
+2 SET X=$$GET1^DIQ(9009016.7,N,.08,"I")
IF X
SET X=$$GET1^DIQ(45.7,X,99)
+3 SET Y=$EXTRACT($$GET1^DIQ(9009016.7,N,.121),1,5)
+4 ;visit type
SET Z=$$GET1^DIQ(9009016.7,N,.03,"I")
+5 QUIT $SELECT(X]"":X,Y]"":Y,Z="O":"",1:"Srv ??")
+6 ;
HOUSING(N) ; returns brief summary of housing data
+1 NEW X,Y
+2 ;housing authorized?
SET X=$$GET1^DIQ(9009016.7,IEN,103,"I")
IF X=""
QUIT ""
+3 ;# of days
SET Y=$$GET1^DIQ(9009016.7,IEN,104)
+4 ;housing status
SET Z=$$GET1^DIQ(9009016.7,IEN,105,"I")
+5 QUIT "HOUS:"_X_$SELECT(Y]"":"x"_Y,1:"")_$SELECT(Z]"":"("_Z_")",1:"")
+6 ;
ESCORT(N) ; return summary of escort info
+1 NEW X,Y
+2 SET X=$$GET1^DIQ(9009016.7,N,107,"I")
IF X]""
SET X="TRVL:"_X
+3 SET Y=$$GET1^DIQ(9009016.7,N,108)
SET Y1=$$GET1^DIQ(9009016.7,N,109)
+4 SET Y2=$$GET1^DIQ(9009016.7,N,110)
+5 IF Y]""
SET Y="HOUS:"_Y_$SELECT(Y1]"":"x"_Y1,1:"")_$SELECT(Y2]"":"("_Y2_")",1:"")
+6 QUIT X_" "_Y_" "_$$GET1^DIQ(9009016.7,N,111)
