BDGSVS ; IHS/ANMC/LJF - SCHED VISIT SUMMARY ;
;;5.3;PIMS;;APR 26, 2002
;
; Assumes BDGN set to ien in Scheduled Visit file
I $$BROWSE^BDGF="B" D EN Q
D ZIS^BDGF("PQ","EN^BDGSVS","SCHED VISIT SUMMARY","BDGN") Q
;
EN ; -- main entry point for BDG SCHED VISIT SUMMARY
NEW VALMCNT
I $E(IOST,1,2)="P-" D INIT,PRINT Q
D TERM^VALM0,CLEAR^VALM1
D EN^VALM("BDG SCHED VISIT SUMMARY")
D CLEAR^VALM1
Q
;
HDR ; -- header code
NEW X
S VALMHDR(1)=$$SP(15)_$$CONF^BDGF
S X=$E($$GET1^DIQ(9009016.7,BDGN,.01),1,25) ;pat name
S X=$$PAD(X,30)_"#"_$$GET1^DIQ(9009016.7,BDGN,.011) ;chart #
S X=$$PAD(X,40)_"Age: "_$$GET1^DIQ(9009016.7,BDGN,.012) ;age
S X=$$PAD(X,50)_"Comm: "_$$GET1^DIQ(9009016.7,BDGN,.013) ;community
S VALMHDR(2)=X
Q
;
INIT ; -- init variables and list array
NEW DFN,LINE,X
K ^TMP("BDGSVS",$J)
S VALMCNT=0
;
S X="SCHEDULED "_$$GET1^DIQ(9009016.7,BDGN,.03)
S LINE=$$SP(79-$L(X)\2)_$G(IORVON)_X_$G(IORVOFF) ;center visit type
D SET(LINE,.VALMCNT),SET("",.VALMCNT)
;
; set up display of fields based on visit type
S X=$$GET1^DIQ(9009016.7,BDGN,.03,"I") Q:X="" D @X
D SET("",.VALMCNT)
D TRAVEL ;travel fields
D SET("",.VALMCNT)
D DATA(203,21) ;additional comments
;
Q
;
A ; process admission fields
NEW FIELD
F FIELD=.02,.13,.04,.05,.08,.09,201,.06,.14,.15,202,.16 D DATA(FIELD,26)
Q
;
D ; process day surgery fields
NEW FIELD
F FIELD=.02,.14,.13,.17,.04,.05,.121,201,202,.06,.16 D DATA(FIELD,26)
Q
;
O ; process outpatient visit fields
NEW FIELD
F FIELD=.02,.13,.04,.05,.11,201,202,.06,.16 D DATA(FIELD,26)
Q
;
DATA(FLD,LEN) ; process one field
NEW X,LINE
S X=$$GET1^DIQ(9009016.7,BDGN,FLD) I X="" Q
D SET($$RJ^XLFSTR($$TITLE(FLD),LEN)_X,.VALMCNT)
Q
;
SET(DATA,NUM) ; put display data into array
S NUM=NUM+1
S ^TMP("BDGSVS",$J,NUM,0)=DATA
Q
;
TITLE(F) ; return field F name or title
NEW X S X=$G(^DD(9009016.7,F,.1))
Q $S(X]"":X,1:$P(^DD(9009016.7,F,0),U))_": "
;
TRAVEL ; set up travel fields for display
NEW FIELD
F FIELD=101,103,104,105,102 D DATA(FIELD,26)
D SET("",.VALMCNT)
F FIELD=106,107,108,109,110,111 D DATA(FIELD,34)
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("BDGSVS",$J)
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)
;
PRINT ; print report to paper
NEW BDGX
U IO D HDR
;
; loop thru display array
S BDGX=0 F S BDGX=$O(^TMP("BDGSVS",$J,BDGX)) Q:'BDGX D
. I $Y>(IOSL-4) D HDG
. W !,^TMP("BDGSVS",$J,BDGX,0)
D ^%ZISC,EXIT
Q
;
HDG ; heading for paper report
D HDR W @IOF,?15,"Scheduled Visit Summary"
F I=1:1 Q:'$D(VALMHDR(I)) W !,VALMHDR(I)
W !,$$REPEAT^XLFSTR("=",80)
Q
;
BDGSVS ; IHS/ANMC/LJF - SCHED VISIT SUMMARY ;
+1 ;;5.3;PIMS;;APR 26, 2002
+2 ;
+3 ; Assumes BDGN set to ien in Scheduled Visit file
+4 IF $$BROWSE^BDGF="B"
DO EN
QUIT
+5 DO ZIS^BDGF("PQ","EN^BDGSVS","SCHED VISIT SUMMARY","BDGN")
QUIT
+6 ;
EN ; -- main entry point for BDG SCHED VISIT SUMMARY
+1 NEW VALMCNT
+2 IF $EXTRACT(IOST,1,2)="P-"
DO INIT
DO PRINT
QUIT
+3 DO TERM^VALM0
DO CLEAR^VALM1
+4 DO EN^VALM("BDG SCHED VISIT SUMMARY")
+5 DO CLEAR^VALM1
+6 QUIT
+7 ;
HDR ; -- header code
+1 NEW X
+2 SET VALMHDR(1)=$$SP(15)_$$CONF^BDGF
+3 ;pat name
SET X=$EXTRACT($$GET1^DIQ(9009016.7,BDGN,.01),1,25)
+4 ;chart #
SET X=$$PAD(X,30)_"#"_$$GET1^DIQ(9009016.7,BDGN,.011)
+5 ;age
SET X=$$PAD(X,40)_"Age: "_$$GET1^DIQ(9009016.7,BDGN,.012)
+6 ;community
SET X=$$PAD(X,50)_"Comm: "_$$GET1^DIQ(9009016.7,BDGN,.013)
+7 SET VALMHDR(2)=X
+8 QUIT
+9 ;
INIT ; -- init variables and list array
+1 NEW DFN,LINE,X
+2 KILL ^TMP("BDGSVS",$JOB)
+3 SET VALMCNT=0
+4 ;
+5 SET X="SCHEDULED "_$$GET1^DIQ(9009016.7,BDGN,.03)
+6 ;center visit type
SET LINE=$$SP(79-$LENGTH(X)\2)_$GET(IORVON)_X_$GET(IORVOFF)
+7 DO SET(LINE,.VALMCNT)
DO SET("",.VALMCNT)
+8 ;
+9 ; set up display of fields based on visit type
+10 SET X=$$GET1^DIQ(9009016.7,BDGN,.03,"I")
IF X=""
QUIT
DO @X
+11 DO SET("",.VALMCNT)
+12 ;travel fields
DO TRAVEL
+13 DO SET("",.VALMCNT)
+14 ;additional comments
DO DATA(203,21)
+15 ;
+16 QUIT
+17 ;
A ; process admission fields
+1 NEW FIELD
+2 FOR FIELD=.02,.13,.04,.05,.08,.09,201,.06,.14,.15,202,.16
DO DATA(FIELD,26)
+3 QUIT
+4 ;
D ; process day surgery fields
+1 NEW FIELD
+2 FOR FIELD=.02,.14,.13,.17,.04,.05,.121,201,202,.06,.16
DO DATA(FIELD,26)
+3 QUIT
+4 ;
O ; process outpatient visit fields
+1 NEW FIELD
+2 FOR FIELD=.02,.13,.04,.05,.11,201,202,.06,.16
DO DATA(FIELD,26)
+3 QUIT
+4 ;
DATA(FLD,LEN) ; process one field
+1 NEW X,LINE
+2 SET X=$$GET1^DIQ(9009016.7,BDGN,FLD)
IF X=""
QUIT
+3 DO SET($$RJ^XLFSTR($$TITLE(FLD),LEN)_X,.VALMCNT)
+4 QUIT
+5 ;
SET(DATA,NUM) ; put display data into array
+1 SET NUM=NUM+1
+2 SET ^TMP("BDGSVS",$JOB,NUM,0)=DATA
+3 QUIT
+4 ;
TITLE(F) ; return field F name or title
+1 NEW X
SET X=$GET(^DD(9009016.7,F,.1))
+2 QUIT $SELECT(X]"":X,1:$PIECE(^DD(9009016.7,F,0),U))_": "
+3 ;
TRAVEL ; set up travel fields for display
+1 NEW FIELD
+2 FOR FIELD=101,103,104,105,102
DO DATA(FIELD,26)
+3 DO SET("",.VALMCNT)
+4 FOR FIELD=106,107,108,109,110,111
DO DATA(FIELD,34)
+5 QUIT
+6 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("BDGSVS",$JOB)
+2 QUIT
+3 ;
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 ;
PRINT ; print report to paper
+1 NEW BDGX
+2 USE IO
DO HDR
+3 ;
+4 ; loop thru display array
+5 SET BDGX=0
FOR
SET BDGX=$ORDER(^TMP("BDGSVS",$JOB,BDGX))
IF 'BDGX
QUIT
Begin DoDot:1
+6 IF $Y>(IOSL-4)
DO HDG
+7 WRITE !,^TMP("BDGSVS",$JOB,BDGX,0)
End DoDot:1
+8 DO ^%ZISC
DO EXIT
+9 QUIT
+10 ;
HDG ; heading for paper report
+1 DO HDR
WRITE @IOF,?15,"Scheduled Visit Summary"
+2 FOR I=1:1
IF '$DATA(VALMHDR(I))
QUIT
WRITE !,VALMHDR(I)
+3 WRITE !,$$REPEAT^XLFSTR("=",80)
+4 QUIT
+5 ;
