- 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)