BSDAMR4 ;cmi/anch/maw - BSD Appointment Management Reports Cancelled Appointment Listing 2/12/2007 1:22:04 PM
;;5.3;PIMS;**1007,1014,1016**;DEC 01, 2006;Build 20
;
;cmi/anch/maw new report for PATCH 1007 item 1007.19
;
ASK ; -- ask user questions
NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDSUB,BSDTT,BSDSTAT,BSDSTE
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
;
S BSDSTAT=$$READ^BDGF("S^C:Clinic;P:Patient","Cancelled By","Clinic")
I BSDSTAT="C" S BSDSTAT("C")="",BSDSTAT("CA")="",BSDSTE="Clinic"
I BSDSTAT="P" S BSDSTAT("PC")="",BSDSTAT("PCA")="",BSDSTE="Patient"
;
;
S Y=$$BROWSE^BDGF Q:"PB"'[Y I Y="B" D EN Q ;browse in list mgr mode
D ZIS^BDGF("PQ","START^BSDAMR4","APPT CAN","BSDSUB;BSDBD;BSDED;BSDSTE;.BSDSTAT;VAUTC*;VAUTD*")
Q
;
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 CAN")
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(30)_"Cancelled by: "_BSDSTE
Q
;
INIT ; -- init variables and list array
S VALMCNT=0 K ^TMP("BSDAMR4",$J),^TMP("BSD",$J)
NEW BSDAR S BSDAR=$S(VAUTC:"^SC",1:"VAUTC")
;
; -- loop by clinic
NEW BSDDFN,CLN,NAME,SUB,APPT,PAT,END,LINE,BSDREAI,BSDCANR
S BSDDFN=0
F S BSDDFN=$O(^DPT(BSDDFN)) Q:'BSDDFN D
. N BSDIEN
. S BSDIEN=0 F S BSDIEN=$O(^DPT(BSDDFN,"S",BSDIEN)) Q:BSDIEN="" D
.. Q:BSDIEN<(BSDBD-.0001) ;quit if date is before selected
.. Q:BSDIEN>(BSDED+.9999) ;quit if date is after selected
.. S CLN=$P($G(^DPT(BSDDFN,"S",BSDIEN,0)),U) ;get clinic ien
.. Q:'$D(@BSDAR@(CLN)) ;quit if clinic wasn't picked
.. Q:$D(^SC("AIHSPC",CLN)) ;quit if principal clinic
.. N BSDST
.. S BSDST=$P($G(^DPT(BSDDFN,"S",BSDIEN,0)),U,2)
.. Q:$G(BSDST)=""
.. Q:'$D(BSDSTAT(BSDST)) ;quit if they do not select the type of cancellation by clinic or patient
.. 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
.. S BSDREAI=$P($G(^DPT(BSDDFN,"S",BSDIEN,0)),U,15)
.. I $G(BSDREAI) S BSDREA=$$GET1^DIQ(409.2,BSDREAI,.01)
.. S BSDCANR=$G(^DPT(BSDDFN,"S",BSDIEN,"R"))
.. I BSDCANR]"" S BSDCANR="("_BSDCANR_")"
.. S PAT=BSDDFN
.. ; put appts into display array
.. S LINE=$$PAD($E($$GET1^DIQ(2,PAT,.01),1,18),18) ;patient name
.. S LINE=LINE_$J($$HRCN^BDGF2(PAT,$$FAC^BSDU(CLN)),7) ;chart#
.. S LINE=$$PAD(LINE,27)_$$GET1^DIQ(2,PAT,.131) ;phone
.. S LINE=$$PAD(LINE,42)_$$FMTE^XLFDT(BSDIEN) ;appt date
.. S LINE=$$PAD(LINE,62)_$S($G(BSDREA)]"":BSDREA_" "_BSDCANR,1:"") ;reason for appoinTment
.. S ^TMP("BSD",$J,SUB,PAT,BSDIEN)=LINE ;sort by category,clinic,date
;
; put sorted list into display array
NEW S1,S2,S3
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
... D SET(^TMP("BSD",$J,S1,S2,S3),.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("BSDAMR4",$J,NUM,0)=LINE
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("BSDAMR4",$J)
Q
;
EXPND ; -- expand code
Q
;
PRINT ; print report to paper
U IO D HDG
NEW X S X=0 F S X=$O(^TMP("BSDAMR4",$J,X)) Q:'X D
. I $Y>(IOSL-4) D HDG
. W !,^TMP("BSDAMR4",$J,X,0)
D ^%ZISC,EXIT
Q
;
HDG ; heading for paper report
D HDR W @IOF,?33,"Cancelled Appointment Listing"
F I=1:1 Q:'$D(VALMHDR(I)) W !,VALMHDR(I)
W !,$$REPEAT^XLFSTR("-",80)
W !,"Patient Name",?20,"HRCN",?28,"Phone",?43,"Appt Date",?63,"Reason"
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)
BSDAMR4 ;cmi/anch/maw - BSD Appointment Management Reports Cancelled Appointment Listing 2/12/2007 1:22:04 PM
+1 ;;5.3;PIMS;**1007,1014,1016**;DEC 01, 2006;Build 20
+2 ;
+3 ;cmi/anch/maw new report for PATCH 1007 item 1007.19
+4 ;
ASK ; -- ask user questions
+1 NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDSUB,BSDTT,BSDSTAT,BSDSTE
+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 SET BSDSTAT=$$READ^BDGF("S^C:Clinic;P:Patient","Cancelled By","Clinic")
+13 IF BSDSTAT="C"
SET BSDSTAT("C")=""
SET BSDSTAT("CA")=""
SET BSDSTE="Clinic"
+14 IF BSDSTAT="P"
SET BSDSTAT("PC")=""
SET BSDSTAT("PCA")=""
SET BSDSTE="Patient"
+15 ;
+16 ;
+17 ;browse in list mgr mode
SET Y=$$BROWSE^BDGF
IF "PB"'[Y
QUIT
IF Y="B"
DO EN
QUIT
+18 DO ZIS^BDGF("PQ","START^BSDAMR4","APPT CAN","BSDSUB;BSDBD;BSDED;BSDSTE;.BSDSTAT;VAUTC*;VAUTD*")
+19 QUIT
+20 ;
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 CAN")
+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(30)_"Cancelled by: "_BSDSTE
+4 QUIT
+5 ;
INIT ; -- init variables and list array
+1 SET VALMCNT=0
KILL ^TMP("BSDAMR4",$JOB),^TMP("BSD",$JOB)
+2 NEW BSDAR
SET BSDAR=$SELECT(VAUTC:"^SC",1:"VAUTC")
+3 ;
+4 ; -- loop by clinic
+5 NEW BSDDFN,CLN,NAME,SUB,APPT,PAT,END,LINE,BSDREAI,BSDCANR
+6 SET BSDDFN=0
+7 FOR
SET BSDDFN=$ORDER(^DPT(BSDDFN))
IF 'BSDDFN
QUIT
Begin DoDot:1
+8 NEW BSDIEN
+9 SET BSDIEN=0
FOR
SET BSDIEN=$ORDER(^DPT(BSDDFN,"S",BSDIEN))
IF BSDIEN=""
QUIT
Begin DoDot:2
+10 ;quit if date is before selected
IF BSDIEN<(BSDBD-.0001)
QUIT
+11 ;quit if date is after selected
IF BSDIEN>(BSDED+.9999)
QUIT
+12 ;get clinic ien
SET CLN=$PIECE($GET(^DPT(BSDDFN,"S",BSDIEN,0)),U)
+13 ;quit if clinic wasn't picked
IF '$DATA(@BSDAR@(CLN))
QUIT
+14 ;quit if principal clinic
IF $DATA(^SC("AIHSPC",CLN))
QUIT
+15 NEW BSDST
+16 SET BSDST=$PIECE($GET(^DPT(BSDDFN,"S",BSDIEN,0)),U,2)
+17 IF $GET(BSDST)=""
QUIT
+18 ;quit if they do not select the type of cancellation by clinic or patient
IF '$DATA(BSDSTAT(BSDST))
QUIT
+19 ;set clinic's name
SET NAME=$$GET1^DIQ(44,CLN,.01)
+20 ;get subcategory for clinic
SET SUB=$$SUB1^BSDWKR1(CLN,NAME)
+21 ;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
+22 SET BSDREAI=$PIECE($GET(^DPT(BSDDFN,"S",BSDIEN,0)),U,15)
+23 IF $GET(BSDREAI)
SET BSDREA=$$GET1^DIQ(409.2,BSDREAI,.01)
+24 SET BSDCANR=$GET(^DPT(BSDDFN,"S",BSDIEN,"R"))
+25 IF BSDCANR]""
SET BSDCANR="("_BSDCANR_")"
+26 SET PAT=BSDDFN
+27 ; put appts into display array
+28 ;patient name
SET LINE=$$PAD($EXTRACT($$GET1^DIQ(2,PAT,.01),1,18),18)
+29 ;chart#
SET LINE=LINE_$JUSTIFY($$HRCN^BDGF2(PAT,$$FAC^BSDU(CLN)),7)
+30 ;phone
SET LINE=$$PAD(LINE,27)_$$GET1^DIQ(2,PAT,.131)
+31 ;appt date
SET LINE=$$PAD(LINE,42)_$$FMTE^XLFDT(BSDIEN)
+32 ;reason for appoinTment
SET LINE=$$PAD(LINE,62)_$SELECT($GET(BSDREA)]"":BSDREA_" "_BSDCANR,1:"")
+33 ;sort by category,clinic,date
SET ^TMP("BSD",$JOB,SUB,PAT,BSDIEN)=LINE
End DoDot:2
End DoDot:1
+34 ;
+35 ; put sorted list into display array
+36 NEW S1,S2,S3
+37 SET S1=0
FOR
SET S1=$ORDER(^TMP("BSD",$JOB,S1))
IF S1=""
QUIT
Begin DoDot:1
+38 DO SET(S1,.VALMCNT)
+39 SET S2=0
FOR
SET S2=$ORDER(^TMP("BSD",$JOB,S1,S2))
IF S2=""
QUIT
Begin DoDot:2
+40 ;I S1'=S2 D SET($$SP(2)_S2,.VALMCNT)
+41 SET S3=0
FOR
SET S3=$ORDER(^TMP("BSD",$JOB,S1,S2,S3))
IF S3=""
QUIT
Begin DoDot:3
+42 DO SET(^TMP("BSD",$JOB,S1,S2,S3),.VALMCNT)
End DoDot:3
+43 IF S1'=S2
DO SET("",.VALMCNT)
End DoDot:2
+44 DO SET("",.VALMCNT)
End DoDot:1
+45 ;
+46 KILL ^TMP("BSD",$JOB)
+47 QUIT
+48 ;
SET(LINE,NUM) ; set line into display array
+1 SET NUM=NUM+1
+2 SET ^TMP("BSDAMR4",$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("BSDAMR4",$JOB)
+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("BSDAMR4",$JOB,X))
IF 'X
QUIT
Begin DoDot:1
+3 IF $Y>(IOSL-4)
DO HDG
+4 WRITE !,^TMP("BSDAMR4",$JOB,X,0)
End DoDot:1
+5 DO ^%ZISC
DO EXIT
+6 QUIT
+7 ;
HDG ; heading for paper report
+1 DO HDR
WRITE @IOF,?33,"Cancelled Appointment Listing"
+2 FOR I=1:1
IF '$DATA(VALMHDR(I))
QUIT
WRITE !,VALMHDR(I)
+3 WRITE !,$$REPEAT^XLFSTR("-",80)
+4 WRITE !,"Patient Name",?20,"HRCN",?28,"Phone",?43,"Appt Date",?63,"Reason"
+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)
