BSDLCA ; IHS/ANMC/LJF - CLERK WHO MADE APPT LIST ;
;;5.3;PIMS;**1010**;APR 26, 2002
;
REPORT ; -- ask user which report to run
K DIR S DIR(0)="SO^1:LIST APPOINTMENTS;2:LIST USERS WITH COUNTS"
S DIR("?",1)="Do you want a List of Appointments with the user who"
S DIR("?",2)="made the appointment OR a List of Users with the number"
S DIR("?",3)="of appointments each made to the clinic."
S DIR("?")=" "
S DIR("A")="Select Type of Report" D ^DIR I Y<1 D EXIT Q
S BSDTYP=Y
;
CLINIC ; -- select clinic
D CLINIC^BSDU(1) I $D(BSDQ) D EXIT Q
;
BD ; -- beginning date
K DIR S DIR(0)="DO^::EX",DIR("A")="Select beginning date"
D ^DIR K DIR G REPORT:$D(DIRUT),REPORT:Y<1 S BSDBDT=Y
;
ED ; -- ending date
K DIR S DIR(0)="DO^::EX",DIR("A")="Select ending date"
D ^DIR K DIR G BD:$D(DIRUT),BD:Y<1 S BSDEDT=Y
;
ZIS ; -- select device
D ZIS^BDGF("PQ","EN^BSDLCA","LIST WHO MADE APPTS","BSD*;VA*")
Q
;
EXIT K X,Y,DIR,BSDTYP,BSDBDT,BSDEDT,VAUTC,VAUTD,ZTSK
K ^TMP("BSDLCA",$J),VALMCNT,BSDLN
D ^%ZISC Q
;
EN ;EP; entry point for start of reports
I BSDTYP=2 D EN^BSDLCA1 Q ;stats report
I IOST'["C-" D INIT,PRINT,EXIT Q ;printing to paper
NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
D EN^VALM("BSDSM APPT MADE LIST")
D CLEAR^VALM1,EXIT Q
;
HDR ;EP; list template header
S VALMHDR(1)=$$SP(25)_$$RANGE^BDGF(BSDBDT,BSDEDT)
Q
;
INIT ;EP; begin calculate for list template list
K ^TMP("BSDLCA",$J),^TMP("BSDLCA1",$J)
NEW SD,SC S BSDLN=0
I VAUTC D ALL Q ;all clinics chosen
; or loop thru selected clinics
S SD="" F S SD=$O(VAUTC(SD)) Q:SD="" S SC=VAUTC(SD) Q:'SC D DISPLAY
S VALMCNT=BSDLN
Q
;
ALL ; -- all clinics
S SC=0 F S SC=$O(^SC(SC)) Q:'SC D
. I $O(VAUTD(0)) Q:'$D(VAUTD(+$P(^SC(SC,0),U,15)))
. Q:'$$ACTV^BSDU(SC,BSDBDT) D DISPLAY
S VALMCNT=BSDLN
Q
;
DISPLAY ; -- loop clinics and set display lines
NEW DATE,PAT,NODE,FIRST,LINE
S FIRST=1
S DATE=BSDBDT-.001
F S DATE=$O(^SC(+SC,"S",DATE)) Q:'DATE Q:DATE>(BSDEDT+.9) D
. S PAT=0 F S PAT=$O(^SC(+SC,"S",DATE,1,PAT)) Q:'PAT D
.. S NODE=^SC(+SC,"S",DATE,1,PAT,0)
.. ; if first time in this clinic, display clinic name
.. I FIRST D SET^BSDLCA1($$GET1^DIQ(44,+SC,.01)) S FIRST=0
.. ;
.. ; set up line with appt date, chart #, age, user, date appt made
.. S LINE=$$PAD($$FMTE^XLFDT(DATE),20)_$J($$HRCN^BDGF2(+NODE,DUZ(2)),6)
.. S LINE=$$PAD(LINE,30)_$$GET1^DIQ(9000001,+NODE,1102.98)
.. S LINE=$$PAD(LINE,40)_$E($$GET1^DIQ(200,+$P(NODE,U,6),.01),1,20)
.. S LINE=$$PAD(LINE,60)_$E($$FMTE^XLFDT($P(NODE,U,7)),1,18)
.. D SET^BSDLCA1(LINE)
I 'FIRST D SET^BSDLCA1("")
Q
;
PRINT ; -- prints list to paper
NEW BSDLN,BSDQT
U IO S BSDQT=0 D HD(0)
S BSDLN=0 F S BSDLN=$O(^TMP("BSDLCA",$J,BSDLN)) Q:'BSDLN Q:BSDQT D
. I $Y>(IOSL-4) D HD(1) Q:BSDQT
. W !,^TMP("BSDLCA",$J,BSDLN,0)
D ^%ZISC
Q
;
HD(X) ; -- heading
I IOST["C-",X S DIR(0)="E" D ^DIR S:'Y BSDQT=1 Q:'Y
W @IOF,!!,?20,"LISTING OF APPTS MADE AND WHO MADE THEM"
W !!,"DATE/TIME",?20,"HRCN"
W ?30,"AGE",?40,"CLERK WHO MADE APPT",?65,"DATE APPT MADE",!!
Q
;
PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
;
SP(N) ; -- returns N number of spaces
Q $$PAD(" ",N)
BSDLCA ; IHS/ANMC/LJF - CLERK WHO MADE APPT LIST ;
+1 ;;5.3;PIMS;**1010**;APR 26, 2002
+2 ;
REPORT ; -- ask user which report to run
+1 KILL DIR
SET DIR(0)="SO^1:LIST APPOINTMENTS;2:LIST USERS WITH COUNTS"
+2 SET DIR("?",1)="Do you want a List of Appointments with the user who"
+3 SET DIR("?",2)="made the appointment OR a List of Users with the number"
+4 SET DIR("?",3)="of appointments each made to the clinic."
+5 SET DIR("?")=" "
+6 SET DIR("A")="Select Type of Report"
DO ^DIR
IF Y<1
DO EXIT
QUIT
+7 SET BSDTYP=Y
+8 ;
CLINIC ; -- select clinic
+1 DO CLINIC^BSDU(1)
IF $DATA(BSDQ)
DO EXIT
QUIT
+2 ;
BD ; -- beginning date
+1 KILL DIR
SET DIR(0)="DO^::EX"
SET DIR("A")="Select beginning date"
+2 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
GOTO REPORT
IF Y<1
GOTO REPORT
SET BSDBDT=Y
+3 ;
ED ; -- ending date
+1 KILL DIR
SET DIR(0)="DO^::EX"
SET DIR("A")="Select ending date"
+2 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
GOTO BD
IF Y<1
GOTO BD
SET BSDEDT=Y
+3 ;
ZIS ; -- select device
+1 DO ZIS^BDGF("PQ","EN^BSDLCA","LIST WHO MADE APPTS","BSD*;VA*")
+2 QUIT
+3 ;
EXIT KILL X,Y,DIR,BSDTYP,BSDBDT,BSDEDT,VAUTC,VAUTD,ZTSK
+1 KILL ^TMP("BSDLCA",$JOB),VALMCNT,BSDLN
+2 DO ^%ZISC
QUIT
+3 ;
EN ;EP; entry point for start of reports
+1 ;stats report
IF BSDTYP=2
DO EN^BSDLCA1
QUIT
+2 ;printing to paper
IF IOST'["C-"
DO INIT
DO PRINT
DO EXIT
QUIT
+3 NEW VALMCNT
DO TERM^VALM0
DO CLEAR^VALM1
+4 DO EN^VALM("BSDSM APPT MADE LIST")
+5 DO CLEAR^VALM1
DO EXIT
QUIT
+6 ;
HDR ;EP; list template header
+1 SET VALMHDR(1)=$$SP(25)_$$RANGE^BDGF(BSDBDT,BSDEDT)
+2 QUIT
+3 ;
INIT ;EP; begin calculate for list template list
+1 KILL ^TMP("BSDLCA",$JOB),^TMP("BSDLCA1",$JOB)
+2 NEW SD,SC
SET BSDLN=0
+3 ;all clinics chosen
IF VAUTC
DO ALL
QUIT
+4 ; or loop thru selected clinics
+5 SET SD=""
FOR
SET SD=$ORDER(VAUTC(SD))
IF SD=""
QUIT
SET SC=VAUTC(SD)
IF 'SC
QUIT
DO DISPLAY
+6 SET VALMCNT=BSDLN
+7 QUIT
+8 ;
ALL ; -- all clinics
+1 SET SC=0
FOR
SET SC=$ORDER(^SC(SC))
IF 'SC
QUIT
Begin DoDot:1
+2 IF $ORDER(VAUTD(0))
IF '$DATA(VAUTD(+$PIECE(^SC(SC,0),U,15)))
QUIT
+3 IF '$$ACTV^BSDU(SC,BSDBDT)
QUIT
DO DISPLAY
End DoDot:1
+4 SET VALMCNT=BSDLN
+5 QUIT
+6 ;
DISPLAY ; -- loop clinics and set display lines
+1 NEW DATE,PAT,NODE,FIRST,LINE
+2 SET FIRST=1
+3 SET DATE=BSDBDT-.001
+4 FOR
SET DATE=$ORDER(^SC(+SC,"S",DATE))
IF 'DATE
QUIT
IF DATE>(BSDEDT+.9)
QUIT
Begin DoDot:1
+5 SET PAT=0
FOR
SET PAT=$ORDER(^SC(+SC,"S",DATE,1,PAT))
IF 'PAT
QUIT
Begin DoDot:2
+6 SET NODE=^SC(+SC,"S",DATE,1,PAT,0)
+7 ; if first time in this clinic, display clinic name
+8 IF FIRST
DO SET^BSDLCA1($$GET1^DIQ(44,+SC,.01))
SET FIRST=0
+9 ;
+10 ; set up line with appt date, chart #, age, user, date appt made
+11 SET LINE=$$PAD($$FMTE^XLFDT(DATE),20)_$JUSTIFY($$HRCN^BDGF2(+NODE,DUZ(2)),6)
+12 SET LINE=$$PAD(LINE,30)_$$GET1^DIQ(9000001,+NODE,1102.98)
+13 SET LINE=$$PAD(LINE,40)_$EXTRACT($$GET1^DIQ(200,+$PIECE(NODE,U,6),.01),1,20)
+14 SET LINE=$$PAD(LINE,60)_$EXTRACT($$FMTE^XLFDT($PIECE(NODE,U,7)),1,18)
+15 DO SET^BSDLCA1(LINE)
End DoDot:2
End DoDot:1
+16 IF 'FIRST
DO SET^BSDLCA1("")
+17 QUIT
+18 ;
PRINT ; -- prints list to paper
+1 NEW BSDLN,BSDQT
+2 USE IO
SET BSDQT=0
DO HD(0)
+3 SET BSDLN=0
FOR
SET BSDLN=$ORDER(^TMP("BSDLCA",$JOB,BSDLN))
IF 'BSDLN
QUIT
IF BSDQT
QUIT
Begin DoDot:1
+4 IF $Y>(IOSL-4)
DO HD(1)
IF BSDQT
QUIT
+5 WRITE !,^TMP("BSDLCA",$JOB,BSDLN,0)
End DoDot:1
+6 DO ^%ZISC
+7 QUIT
+8 ;
HD(X) ; -- heading
+1 IF IOST["C-"
IF X
SET DIR(0)="E"
DO ^DIR
IF 'Y
SET BSDQT=1
IF 'Y
QUIT
+2 WRITE @IOF,!!,?20,"LISTING OF APPTS MADE AND WHO MADE THEM"
+3 WRITE !!,"DATE/TIME",?20,"HRCN"
+4 WRITE ?30,"AGE",?40,"CLERK WHO MADE APPT",?65,"DATE APPT MADE",!!
+5 QUIT
+6 ;
PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
+1 QUIT $EXTRACT(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
+2 ;
SP(N) ; -- returns N number of spaces
+1 QUIT $$PAD(" ",N)
