BSDAMR3.m

BSDAMR3 ;cmi/anch/maw - BSD Appointment Management Reports - Eligibility Appoinment List 2/12/2007 1:20:15 PM

 ;;5.3;PIMS;**1007**;DEC 01, 2006

 ;

 ;cmi/anch/maw new report for PATCH 1007 item 1007.18 Eligibility Appointment List

 ;

ASK ; -- ask user questions

 NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDSUB,BSDTT

 D EXIT

 ;

 S BSDSUB="Clinic"

 ;

 ; get clinic arrays based on subtotal category

 D CLINIC^BSDU(2) Q:$D(BSDQ)

 ;

 S BSDBD=$$READ^BDGF("DO^::EX","Select First Date to Search") Q:'BSDBD

 S BSDED=$$READ^BDGF("DO^::EX","Select Last Date to Search") Q:'BSDED

 ;

 N BSDSRT

 S BSDSRT=$$READ^BDGF("S^D:Date/Time;P:Patient Name;C:Coverage Type","Sort By","Date/Time")

 ;

 D CT

 N BSDCTYP

 S BSDCTYP=$$GETCT()

 I $G(BSDCT)="" S BSDCT(4)=""

 ;

 S Y=$$BROWSE^BDGF Q:"PB"'[Y  I Y="B" D EN Q  ;browse in list mgr mode

 D ZIS^BDGF("PQ","START^BSDAMR3","APPT ELG","BSDSUB;BSDBD;BSDED;VAUTC*;VAUTD*")

 Q

 ;

CT ;-- coverage type

 W !!,?5,"1) Medicaid",!,?5,"2) Medicare",!,?5,"3) Private Insurace",!,?5,"4) All",!

 S BSDCT=$$READ^BDGF("LO^1:4","Show which Coverage Type(s)","")

 I $G(BSDCT)]"" D

 . N I

 . F I=1:1 D  Q:$P(BSDCT,",",I)=""

 .. Q:$P(BSDCT,",",I)=""

 .. S BSDCT($P(BSDCT,",",I))=""

 Q

 ;

GETCT() ;-- return coverage types for header

 N BSDSTR

 S BSDSTR=""

 I $D(BSDCT(1)) S BSDSTR="MCD/"

 I $D(BSDCT(2)) S BSDSTR=BSDSTR_"MCR/"

 I $D(BSDCT(3)) S BSDSTR=BSDSTR_"PI"

 I $D(BSDCT(4)) S BSDSTR="MCR/MCD/PI"

 I $G(BSDSTR)="" S BSDSTR="MCR/MCD/PI"

 Q BSDSTR

 ;

START ;EP; -- re-entry for printing to paper

 D INIT,PRINT Q

 ;

EN ; -- main entry point for BSDRM APPT MGT NO ACTION

 NEW VALMCNT D TERM^VALM0,CLEAR^VALM1

 D EN^VALM("BSDRM APPT MGT ELG")

 D CLEAR^VALM1

 Q

 ;

HDR ; -- header code

 S VALMHDR(1)=$$SP(15)_$$CONF^BSDU

 S VALMHDR(2)=$$SP(20)_"For dates: "_$$RANGE^BDGF(BSDBD,BSDED)

 S VALMHDR(3)=$$SP(25)_"For Coverage Type(s): "_$G(BSDCTYP)

 Q

 ;

INIT ; -- init variables and list array

 S VALMCNT=0 K ^TMP("BSDAMR3",$J),^TMP("BSD",$J)

 NEW BSDAR S BSDAR=$S(VAUTC:"^SC",1:"VAUTC")

 ;

 ; -- loop by clinic

 NEW CLN,NAME,SUB,APPT,APPN,PAT,STATUS,TYPE,END,LINE

 S CLN=0 F  S CLN=$O(@BSDAR@(CLN)) Q:'CLN  D

 . Q:$D(^SC("AIHSPC",CLN))               ;quit if principal clinic

 . S NAME=$$GET1^DIQ(44,CLN,.01)         ;set clinic's name

 . S SUB=$$SUB1^BSDWKR1(CLN,NAME)        ;get subcategory for clinic

 . I '$G(VAUTD) Q:'$D(VAUTD(+$P($G(^SC(CLN,0)),U,15)))  ;cmi/anch/maw 11/22/06 added to screen on division item 1007.17 patch 1007

 . ;

 . ; -- then by appt date (within range)

 . S APPT=BSDBD,END=BSDED+.2400

 . F  S APPT=$O(^SC(CLN,"S",APPT)) Q:'APPT!(APPT>END)  D

 .. ;

 .. ; -- then find appts to count

 .. S APPN=0

 .. F  S APPN=$O(^SC(CLN,"S",APPT,1,APPN)) Q:'APPN  D

 ... S PAT=+^SC(CLN,"S",APPT,1,APPN,0)                ;patient ien

 ... S BSDSSN=$P($G(^DPT(PAT,0)),U,9)                    ;patient SSN

 ... N BSDMCR,BSDMCD,BSDPI

 ... S BSDMCR=$$MCR^AUPNPAT(PAT,APPT) I BSDMCR=1 S BSDMCR="MCR/"

 ... S BSDMCD=$$MCD^AUPNPAT(PAT,APPT) I BSDMCD=1 S BSDMCD="MCD/"

 ... S BSDPI=$$PI^AUPNPAT(PAT,APPT) I BSDPI=1 S BSDPI="PVT/"

 ... I $G(BSDMCR)=0 K BSDMCR

 ... I $G(BSDMCD)=0 K BSDMCD

 ... I $G(BSDPI)=0 K BSDPI

 ... I '$D(BSDCT(2)),'$D(BSDCT(4)) K BSDMCR

 ... I '$D(BSDCT(1)),'$D(BSDCT(4)) K BSDMCD

 ... I '$D(BSDCT(3)),'$D(BSDCT(4)) K BSDPI

 ... N BSDINS

 ... S BSDINS="*"_$G(BSDMCR)_$G(BSDMCD)_$G(BSDPI)_"*"

 ... ;

 ... ; put appts into display array

 ... S LINE=$$PAD($$FMTE^XLFDT(APPT),22)                   ;appt date

 ... S LINE=LINE_$J($$HRCN^BDGF2(PAT,$$FAC^BSDU(CLN)),7)   ;chart#

 ... S LINE=$$PAD(LINE,33)_$E($$GET1^DIQ(2,PAT,.01),1,18)  ;patient name

 ... S LINE=$$PAD(LINE,53)_$G(BSDSSN)                      ;ssn

 ... S LINE=$$PAD(LINE,64)_BSDINS                          ;insurance info

 ... I BSDSRT="D" D

 .... S ^TMP("BSD",$J,BSDSUB,NAME,APPT,BSDINS)=LINE  ;sort by category,clinic,date

 ... I BSDSRT="P" D

 .... S ^TMP("BSD",$J,BSDSUB,NAME,PAT,APPT)=LINE  ;sort by category,clinic,date

 ... I BSDSRT="C" D

 .... S ^TMP("BSD",$J,BSDSUB,NAME,BSDINS,APPT)=LINE  ;sort by category,clinic,date

 ;

 ; put sorted list into display array

 NEW S1,S2,S3,S4

 S S1=0 F  S S1=$O(^TMP("BSD",$J,S1)) Q:S1=""  D

 . D SET(S1,.VALMCNT)

 . S S2=0 F  S S2=$O(^TMP("BSD",$J,S1,S2)) Q:S2=""  D

 .. I S1'=S2 D SET($$SP(2)_S2,.VALMCNT)

 .. S S3=0 F  S S3=$O(^TMP("BSD",$J,S1,S2,S3)) Q:S3=""  D

 ... S S4=0 F  S S4=$O(^TMP("BSD",$J,S1,S2,S3,S4)) Q:S4=""  D

 .... D SET(^TMP("BSD",$J,S1,S2,S3,S4),.VALMCNT)

 ... I S1'=S2 D SET("",.VALMCNT)

 . D SET("",.VALMCNT)

 ;

 K ^TMP("BSD",$J)

 Q

 ;

SET(LINE,NUM) ; set line into display array

 S NUM=NUM+1

 S ^TMP("BSDAMR3",$J,NUM,0)=LINE

 Q

 ;

HELP ; -- help code

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

 Q

 ;

EXIT ; -- exit code

 K ^TMP("BSDAMR3",$J),BSDCT

 Q

 ;

EXPND ; -- expand code

 Q

 ;

PRINT ; print report to paper

 U IO D HDG

 NEW X S X=0 F  S X=$O(^TMP("BSDAMR3",$J,X)) Q:'X  D

 . I $Y>(IOSL-4) D HDG

 . W !,^TMP("BSDAMR3",$J,X,0)

 D ^%ZISC,EXIT

 Q

 ;

HDG ; heading for paper report

 D HDR W @IOF,?30,"Appointments Elgibility Information"

 F I=1:1 Q:'$D(VALMHDR(I))  W !,VALMHDR(I)

 W !,$$REPEAT^XLFSTR("-",80)

 W !,"Appt Date",?24,"HRCN",?34,"Patient Name",?54,"SSN",?65,"Insurance Info"

 W !,$$REPEAT^XLFSTR("=",80)

 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)

 ;

BSDAMR3   ;cmi/anch/maw - BSD Appointment Management Reports - Eligibility Appoinment List 2/12/2007 1:20:15 PM

 +1       ;;5.3;PIMS;**1007**;DEC 01, 2006

 +2       ;

 +3       ;cmi/anch/maw new report for PATCH 1007 item 1007.18 Eligibility Appointment List

 +4       ;

ASK       ; -- ask user questions

 +1        NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDSUB,BSDTT

 +2        DO EXIT

 +3       ;

 +4        SET BSDSUB="Clinic"

 +5       ;

 +6       ; get clinic arrays based on subtotal category

 +7        DO CLINIC^BSDU(2)

           IF $DATA(BSDQ)

               QUIT 

 +8       ;

 +9        SET BSDBD=$$READ^BDGF("DO^::EX","Select First Date to Search")

           IF 'BSDBD

               QUIT 

 +10       SET BSDED=$$READ^BDGF("DO^::EX","Select Last Date to Search")

           IF 'BSDED

               QUIT 

 +11      ;

 +12       NEW BSDSRT

 +13       SET BSDSRT=$$READ^BDGF("S^D:Date/Time;P:Patient Name;C:Coverage Type","Sort By","Date/Time")

 +14      ;

 +15       DO CT

 +16       NEW BSDCTYP

 +17       SET BSDCTYP=$$GETCT()

 +18       IF $GET(BSDCT)=""

               SET BSDCT(4)=""

 +19      ;

 +20      ;browse in list mgr mode

           SET Y=$$BROWSE^BDGF

           IF "PB"'[Y

               QUIT 

           IF Y="B"

               DO EN

               QUIT 

 +21       DO ZIS^BDGF("PQ","START^BSDAMR3","APPT ELG","BSDSUB;BSDBD;BSDED;VAUTC*;VAUTD*")

 +22       QUIT 

 +23      ;

CT        ;-- coverage type

 +1        WRITE !!,?5,"1) Medicaid",!,?5,"2) Medicare",!,?5,"3) Private Insurace",!,?5,"4) All",!

 +2        SET BSDCT=$$READ^BDGF("LO^1:4","Show which Coverage Type(s)","")

 +3        IF $GET(BSDCT)]""

               Begin DoDot:1

 +4                NEW I

 +5                FOR I=1:1

                       Begin DoDot:2

 +6                        IF $PIECE(BSDCT,",",I)=""

                               QUIT 

 +7                        SET BSDCT($PIECE(BSDCT,",",I))=""

                       End DoDot:2

                       IF $PIECE(BSDCT,",",I)=""

                           QUIT 

               End DoDot:1

 +8        QUIT 

 +9       ;

GETCT()   ;-- return coverage types for header

 +1        NEW BSDSTR

 +2        SET BSDSTR=""

 +3        IF $DATA(BSDCT(1))

               SET BSDSTR="MCD/"

 +4        IF $DATA(BSDCT(2))

               SET BSDSTR=BSDSTR_"MCR/"

 +5        IF $DATA(BSDCT(3))

               SET BSDSTR=BSDSTR_"PI"

 +6        IF $DATA(BSDCT(4))

               SET BSDSTR="MCR/MCD/PI"

 +7        IF $GET(BSDSTR)=""

               SET BSDSTR="MCR/MCD/PI"

 +8        QUIT BSDSTR

 +9       ;

START     ;EP; -- re-entry for printing to paper

 +1        DO INIT

           DO PRINT

           QUIT 

 +2       ;

EN        ; -- main entry point for BSDRM APPT MGT NO ACTION

 +1        NEW VALMCNT

           DO TERM^VALM0

           DO CLEAR^VALM1

 +2        DO EN^VALM("BSDRM APPT MGT ELG")

 +3        DO CLEAR^VALM1

 +4        QUIT 

 +5       ;

HDR       ; -- header code

 +1        SET VALMHDR(1)=$$SP(15)_$$CONF^BSDU

 +2        SET VALMHDR(2)=$$SP(20)_"For dates: "_$$RANGE^BDGF(BSDBD,BSDED)

 +3        SET VALMHDR(3)=$$SP(25)_"For Coverage Type(s): "_$GET(BSDCTYP)

 +4        QUIT 

 +5       ;

INIT      ; -- init variables and list array

 +1        SET VALMCNT=0

           KILL ^TMP("BSDAMR3",$JOB),^TMP("BSD",$JOB)

 +2        NEW BSDAR

           SET BSDAR=$SELECT(VAUTC:"^SC",1:"VAUTC")

 +3       ;

 +4       ; -- loop by clinic

 +5        NEW CLN,NAME,SUB,APPT,APPN,PAT,STATUS,TYPE,END,LINE

 +6        SET CLN=0

           FOR 

               SET CLN=$ORDER(@BSDAR@(CLN))

               IF 'CLN

                   QUIT 

               Begin DoDot:1

 +7       ;quit if principal clinic

                   IF $DATA(^SC("AIHSPC",CLN))

                       QUIT 

 +8       ;set clinic's name

                   SET NAME=$$GET1^DIQ(44,CLN,.01)

 +9       ;get subcategory for clinic

                   SET SUB=$$SUB1^BSDWKR1(CLN,NAME)

 +10      ;cmi/anch/maw 11/22/06 added to screen on division item 1007.17 patch 1007

                   IF '$GET(VAUTD)

                       IF '$DATA(VAUTD(+$PIECE($GET(^SC(CLN,0)),U,15)))

                           QUIT 

 +11      ;

 +12      ; -- then by appt date (within range)

 +13               SET APPT=BSDBD

                   SET END=BSDED+.2400

 +14               FOR 

                       SET APPT=$ORDER(^SC(CLN,"S",APPT))

                       IF 'APPT!(APPT>END)

                           QUIT 

                       Begin DoDot:2

 +15      ;

 +16      ; -- then find appts to count

 +17                       SET APPN=0

 +18                       FOR 

                               SET APPN=$ORDER(^SC(CLN,"S",APPT,1,APPN))

                               IF 'APPN

                                   QUIT 

                               Begin DoDot:3

 +19      ;patient ien

                                   SET PAT=+^SC(CLN,"S",APPT,1,APPN,0)

 +20      ;patient SSN

                                   SET BSDSSN=$PIECE($GET(^DPT(PAT,0)),U,9)

 +21                               NEW BSDMCR,BSDMCD,BSDPI

 +22                               SET BSDMCR=$$MCR^AUPNPAT(PAT,APPT)

                                   IF BSDMCR=1

                                       SET BSDMCR="MCR/"

 +23                               SET BSDMCD=$$MCD^AUPNPAT(PAT,APPT)

                                   IF BSDMCD=1

                                       SET BSDMCD="MCD/"

 +24                               SET BSDPI=$$PI^AUPNPAT(PAT,APPT)

                                   IF BSDPI=1

                                       SET BSDPI="PVT/"

 +25                               IF $GET(BSDMCR)=0

                                       KILL BSDMCR

 +26                               IF $GET(BSDMCD)=0

                                       KILL BSDMCD

 +27                               IF $GET(BSDPI)=0

                                       KILL BSDPI

 +28                               IF '$DATA(BSDCT(2))

                                       IF '$DATA(BSDCT(4))

                                           KILL BSDMCR

 +29                               IF '$DATA(BSDCT(1))

                                       IF '$DATA(BSDCT(4))

                                           KILL BSDMCD

 +30                               IF '$DATA(BSDCT(3))

                                       IF '$DATA(BSDCT(4))

                                           KILL BSDPI

 +31                               NEW BSDINS

 +32                               SET BSDINS="*"_$GET(BSDMCR)_$GET(BSDMCD)_$GET(BSDPI)_"*"

 +33      ;

 +34      ; put appts into display array

 +35      ;appt date

                                   SET LINE=$$PAD($$FMTE^XLFDT(APPT),22)

 +36      ;chart#

                                   SET LINE=LINE_$JUSTIFY($$HRCN^BDGF2(PAT,$$FAC^BSDU(CLN)),7)

 +37      ;patient name

                                   SET LINE=$$PAD(LINE,33)_$EXTRACT($$GET1^DIQ(2,PAT,.01),1,18)

 +38      ;ssn

                                   SET LINE=$$PAD(LINE,53)_$GET(BSDSSN)

 +39      ;insurance info

                                   SET LINE=$$PAD(LINE,64)_BSDINS

 +40                               IF BSDSRT="D"

                                       Begin DoDot:4

 +41      ;sort by category,clinic,date

                                           SET ^TMP("BSD",$JOB,BSDSUB,NAME,APPT,BSDINS)=LINE

                                       End DoDot:4

 +42                               IF BSDSRT="P"

                                       Begin DoDot:4

 +43      ;sort by category,clinic,date

                                           SET ^TMP("BSD",$JOB,BSDSUB,NAME,PAT,APPT)=LINE

                                       End DoDot:4

 +44                               IF BSDSRT="C"

                                       Begin DoDot:4

 +45      ;sort by category,clinic,date

                                           SET ^TMP("BSD",$JOB,BSDSUB,NAME,BSDINS,APPT)=LINE

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +46      ;

 +47      ; put sorted list into display array

 +48       NEW S1,S2,S3,S4

 +49       SET S1=0

           FOR 

               SET S1=$ORDER(^TMP("BSD",$JOB,S1))

               IF S1=""

                   QUIT 

               Begin DoDot:1

 +50               DO SET(S1,.VALMCNT)

 +51               SET S2=0

                   FOR 

                       SET S2=$ORDER(^TMP("BSD",$JOB,S1,S2))

                       IF S2=""

                           QUIT 

                       Begin DoDot:2

 +52                       IF S1'=S2

                               DO SET($$SP(2)_S2,.VALMCNT)

 +53                       SET S3=0

                           FOR 

                               SET S3=$ORDER(^TMP("BSD",$JOB,S1,S2,S3))

                               IF S3=""

                                   QUIT 

                               Begin DoDot:3

 +54                               SET S4=0

                                   FOR 

                                       SET S4=$ORDER(^TMP("BSD",$JOB,S1,S2,S3,S4))

                                       IF S4=""

                                           QUIT 

                                       Begin DoDot:4

 +55                                       DO SET(^TMP("BSD",$JOB,S1,S2,S3,S4),.VALMCNT)

                                       End DoDot:4

 +56                               IF S1'=S2

                                       DO SET("",.VALMCNT)

                               End DoDot:3

                       End DoDot:2

 +57               DO SET("",.VALMCNT)

               End DoDot:1

 +58      ;

 +59       KILL ^TMP("BSD",$JOB)

 +60       QUIT 

 +61      ;

SET(LINE,NUM) ; set line into display array

 +1        SET NUM=NUM+1

 +2        SET ^TMP("BSDAMR3",$JOB,NUM,0)=LINE

 +3        QUIT 

 +4       ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        KILL ^TMP("BSDAMR3",$JOB),BSDCT

 +2        QUIT 

 +3       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

PRINT     ; print report to paper

 +1        USE IO

           DO HDG

 +2        NEW X

           SET X=0

           FOR 

               SET X=$ORDER(^TMP("BSDAMR3",$JOB,X))

               IF 'X

                   QUIT 

               Begin DoDot:1

 +3                IF $Y>(IOSL-4)

                       DO HDG

 +4                WRITE !,^TMP("BSDAMR3",$JOB,X,0)

               End DoDot:1

 +5        DO ^%ZISC

           DO EXIT

 +6        QUIT 

 +7       ;

HDG       ; heading for paper report

 +1        DO HDR

           WRITE @IOF,?30,"Appointments Elgibility Information"

 +2        FOR I=1:1

               IF '$DATA(VALMHDR(I))

                   QUIT 

               WRITE !,VALMHDR(I)

 +3        WRITE !,$$REPEAT^XLFSTR("-",80)

 +4        WRITE !,"Appt Date",?24,"HRCN",?34,"Patient Name",?54,"SSN",?65,"Insurance Info"

 +5        WRITE !,$$REPEAT^XLFSTR("=",80)

 +6        QUIT 

 +7       ;

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       ;