Routine: BDGSVL1

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

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"

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)

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

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

SET(DATA,NUM) ; put display line into array

 S NUM=NUM+1

 S ^TMP("BDGSVL",$J,NUM,0)=DATA

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)

CAPD ; set up detailed caption

 S VALMCAP=$$PAD(" Patient",20)_"Chart#  Age Sex Expected On  Type"

 S VALMCAP=$$PAD(VALMCAP_"  Status      Community",79)

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

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)

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

EXIT ; -- exit code

 K ^TMP("BDGSVL",$J)

 K BDGBD,BDGED,BDGVT,BDGEX,BDGS1,BDGS2,BDGRT

EXPND ; -- expand code

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)

BDGSVL1.m