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 ;
