BSDALL ; IHS/ANMC/LJF - IHS APPT LIST - LT CODE ;
;;5.3;PIMS;**1004,1011**;MAY 28, 2004
;IHS/OIT/LJF 07/20/2005 PATCH 1004 moved spacing of heading
;
;
;cmi/flag/maw 10/05/2009 PATCH 1011 RQMT73 allow multiple dates for appointment list
;
EN ;EP; -- main entry point for appt list list template
;cmi/maw 10/5/2009 PATCH 1011 RQMT73 code follows
I IOST'["C-" D Q
. NEW BSDPRT
. S BSDPRT=1 D INIT
. F BSDI=1:1:BSDCOPY W:BSDI>1 @IOF D PRINT ;print # of copies desired
. D ^%ZISC,EXIT
.;
;I IOST'["C-" D Q
;. N BSDDA
;. S BSDDA=0 F S BSDDA=$O(BSDD(BSDDA)) Q:'BSDDA D
;.. S BSDD=+$G(BSDD(BSDDA))
;.. NEW BSDPRT
;.. S BSDPRT=1 D INIT
;.. F BSDI=1:1:BSDCOPY W:BSDI>1 @IOF D PRINT ;print # of copies desired
;. D ^%ZISC,EXIT
;.;
I IOST["C-" D Q
. S BSDD=$S($O(BSDD("")):$G(BSDD($O(BSDD("")))),1:$G(BSDD))
. NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
. D EN^VALM("BSDAM APPT LIST LONG")
. D CLEAR^VALM1
;cmi/maw PATCH 1011 orig
;NEW BSDPRT
;I IOST'["C-" D Q ;printing to paper
;. S BSDPRT=1 D INIT
;. F BSDI=1:1:BSDCOPY W:BSDI>1 @IOF D PRINT ;print # of copies desired
;. D ^%ZISC,EXIT
;
;NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
;D EN^VALM("BSDAM APPT LIST LONG")
;D CLEAR^VALM1
Q
;
HDR ;EP; -- header code
S VALMHDR(1)=$$REPEAT^XLFSTR(" ",10)_$$CONF^BDGF
S X=$$PAD(" Time",7)_$$PAD("Patient Name",19)_$$PAD("HRCN",10)
;S VALMHDR(2)=X_"DOB (Age) Lab@ X-Ray@ EKG@"
S VALMHDR(2)=X_"DOB (Age) Lab@ X-Ray@ EKG@" ;IHS/OIT/LJF 7/20/2005 PATCH 1004
S VALMHDR(3)=$$SP(9)_"Insurance & Appointment Information"
Q
;
INIT ;EP; -- init variables and list array
K ^TMP("BSDAL",$J) S VALMCNT=0
D START^BSDAL2
Q
;
PRINT ; -- print list to paper
NEW BSDN,BSDT,BSDLN,BSDPG,BSDSAV,BDGLNS
U IO D INIT^BDGF ;initialize heading variables - BDG namespaced
S X=3 S:BSDAMB X=4 I (BSDPH)!(BSDPCMM) S X=X+1
S BSDLNS=X+4 ;# of lines per patient depending on data asked for
S BSDN=0
F S BSDN=$O(^TMP("BSDAL",$J,BSDN)) Q:'BSDN D
. S BSDLN=^TMP("BSDAL",$J,BSDN,0)
. I $E(BSDLN,1,5)="@@@@@" S BSDSAV=$P(BSDLN,"@@@@@",2) D HDG Q
. I BSDLN="",($Y>(IOSL-BSDLNS)) D HDG
. I $Y>(IOSL-4) D HDG
. W !,BSDLN
Q
;
HDG ;Print report header
S BSDPG=$G(BSDPG)+1 I BSDPG>1 W @IOF
W !?11,"*****",$$CONF^BDGF,"*****",?70,$J(BDGTIME,9)
W !?(80-$L(BDGFAC)\2),BDGFAC,?67,BDGDATE
I '$D(BSDT) S BSDT=$$FMTE^XLFDT(BSDD)
NEW X S X="Appointment List for "_$S($$CNTD():"Multiple Dates",1:BSDT_" ("_$$DOW^XLFDT(BSDD)_")")
W !,BDGUSR,?(80-$L(X)\2),X,?71,"Page: ",$J(BSDPG,2)
W !,$$REPEAT^XLFSTR("=",80)
W !?2,"Time",?7,"Patient Name",?30,"HRCN",?40,"DOB(Age)"
W ?53," Lab@",?62,"X-Ray@",?74,"EKG@"
W !?9,"Insurance & Appointment Information"
W !,$$REPEAT^XLFSTR("-",80)
W !!,BSDSAV,!,$$REPEAT^XLFSTR("=",80)
Q
;
HELP ;EP; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ;EP; -- exit code
K ^TMP("BSDAL",$J) K VALMCNT,BSDI
D PRTKL^BDGF ;kill print to paper variables
S VALMNOFF=1 ;suppress form feed before next question
Q
;
EXPND ;EP; -- expand code
Q
;
PAD(D,L) ; -- 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)
;
CNTD() ;-- count number of days in BSDD array
N CDA,CCNT
S CCNT=0
S CDA=0 F S CDA=$O(BSDD(CDA)) Q:'CDA D
. S CCNT=CCNT+1
I CCNT>1 Q 1
Q 0
;
BSDALL ; IHS/ANMC/LJF - IHS APPT LIST - LT CODE ;
+1 ;;5.3;PIMS;**1004,1011**;MAY 28, 2004
+2 ;IHS/OIT/LJF 07/20/2005 PATCH 1004 moved spacing of heading
+3 ;
+4 ;
+5 ;cmi/flag/maw 10/05/2009 PATCH 1011 RQMT73 allow multiple dates for appointment list
+6 ;
EN ;EP; -- main entry point for appt list list template
+1 ;cmi/maw 10/5/2009 PATCH 1011 RQMT73 code follows
+2 IF IOST'["C-"
Begin DoDot:1
+3 NEW BSDPRT
+4 SET BSDPRT=1
DO INIT
+5 ;print # of copies desired
FOR BSDI=1:1:BSDCOPY
IF BSDI>1
WRITE @IOF
DO PRINT
+6 DO ^%ZISC
DO EXIT
+7 ;
End DoDot:1
QUIT
+8 ;I IOST'["C-" D Q
+9 ;. N BSDDA
+10 ;. S BSDDA=0 F S BSDDA=$O(BSDD(BSDDA)) Q:'BSDDA D
+11 ;.. S BSDD=+$G(BSDD(BSDDA))
+12 ;.. NEW BSDPRT
+13 ;.. S BSDPRT=1 D INIT
+14 ;.. F BSDI=1:1:BSDCOPY W:BSDI>1 @IOF D PRINT ;print # of copies desired
+15 ;. D ^%ZISC,EXIT
+16 ;.;
+17 IF IOST["C-"
Begin DoDot:1
+18 SET BSDD=$SELECT($ORDER(BSDD("")):$GET(BSDD($ORDER(BSDD("")))),1:$GET(BSDD))
+19 NEW VALMCNT
DO TERM^VALM0
DO CLEAR^VALM1
+20 DO EN^VALM("BSDAM APPT LIST LONG")
+21 DO CLEAR^VALM1
End DoDot:1
QUIT
+22 ;cmi/maw PATCH 1011 orig
+23 ;NEW BSDPRT
+24 ;I IOST'["C-" D Q ;printing to paper
+25 ;. S BSDPRT=1 D INIT
+26 ;. F BSDI=1:1:BSDCOPY W:BSDI>1 @IOF D PRINT ;print # of copies desired
+27 ;. D ^%ZISC,EXIT
+28 ;
+29 ;NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
+30 ;D EN^VALM("BSDAM APPT LIST LONG")
+31 ;D CLEAR^VALM1
+32 QUIT
+33 ;
HDR ;EP; -- header code
+1 SET VALMHDR(1)=$$REPEAT^XLFSTR(" ",10)_$$CONF^BDGF
+2 SET X=$$PAD(" Time",7)_$$PAD("Patient Name",19)_$$PAD("HRCN",10)
+3 ;S VALMHDR(2)=X_"DOB (Age) Lab@ X-Ray@ EKG@"
+4 ;IHS/OIT/LJF 7/20/2005 PATCH 1004
SET VALMHDR(2)=X_"DOB (Age) Lab@ X-Ray@ EKG@"
+5 SET VALMHDR(3)=$$SP(9)_"Insurance & Appointment Information"
+6 QUIT
+7 ;
INIT ;EP; -- init variables and list array
+1 KILL ^TMP("BSDAL",$JOB)
SET VALMCNT=0
+2 DO START^BSDAL2
+3 QUIT
+4 ;
PRINT ; -- print list to paper
+1 NEW BSDN,BSDT,BSDLN,BSDPG,BSDSAV,BDGLNS
+2 ;initialize heading variables - BDG namespaced
USE IO
DO INIT^BDGF
+3 SET X=3
IF BSDAMB
SET X=4
IF (BSDPH)!(BSDPCMM)
SET X=X+1
+4 ;# of lines per patient depending on data asked for
SET BSDLNS=X+4
+5 SET BSDN=0
+6 FOR
SET BSDN=$ORDER(^TMP("BSDAL",$JOB,BSDN))
IF 'BSDN
QUIT
Begin DoDot:1
+7 SET BSDLN=^TMP("BSDAL",$JOB,BSDN,0)
+8 IF $EXTRACT(BSDLN,1,5)="@@@@@"
SET BSDSAV=$PIECE(BSDLN,"@@@@@",2)
DO HDG
QUIT
+9 IF BSDLN=""
IF ($Y>(IOSL-BSDLNS))
DO HDG
+10 IF $Y>(IOSL-4)
DO HDG
+11 WRITE !,BSDLN
End DoDot:1
+12 QUIT
+13 ;
HDG ;Print report header
+1 SET BSDPG=$GET(BSDPG)+1
IF BSDPG>1
WRITE @IOF
+2 WRITE !?11,"*****",$$CONF^BDGF,"*****",?70,$JUSTIFY(BDGTIME,9)
+3 WRITE !?(80-$LENGTH(BDGFAC)\2),BDGFAC,?67,BDGDATE
+4 IF '$DATA(BSDT)
SET BSDT=$$FMTE^XLFDT(BSDD)
+5 NEW X
SET X="Appointment List for "_$SELECT($$CNTD():"Multiple Dates",1:BSDT_" ("_$$DOW^XLFDT(BSDD)_")")
+6 WRITE !,BDGUSR,?(80-$LENGTH(X)\2),X,?71,"Page: ",$JUSTIFY(BSDPG,2)
+7 WRITE !,$$REPEAT^XLFSTR("=",80)
+8 WRITE !?2,"Time",?7,"Patient Name",?30,"HRCN",?40,"DOB(Age)"
+9 WRITE ?53," Lab@",?62,"X-Ray@",?74,"EKG@"
+10 WRITE !?9,"Insurance & Appointment Information"
+11 WRITE !,$$REPEAT^XLFSTR("-",80)
+12 WRITE !!,BSDSAV,!,$$REPEAT^XLFSTR("=",80)
+13 QUIT
+14 ;
HELP ;EP; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ;EP; -- exit code
+1 KILL ^TMP("BSDAL",$JOB)
KILL VALMCNT,BSDI
+2 ;kill print to paper variables
DO PRTKL^BDGF
+3 ;suppress form feed before next question
SET VALMNOFF=1
+4 QUIT
+5 ;
EXPND ;EP; -- expand code
+1 QUIT
+2 ;
PAD(D,L) ; -- 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 ;
CNTD() ;-- count number of days in BSDD array
+1 NEW CDA,CCNT
+2 SET CCNT=0
+3 SET CDA=0
FOR
SET CDA=$ORDER(BSDD(CDA))
IF 'CDA
QUIT
Begin DoDot:1
+4 SET CCNT=CCNT+1
End DoDot:1
+5 IF CCNT>1
QUIT 1
+6 QUIT 0
+7 ;
