BSDALL.m

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       ;