Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BSDLCA

BSDLCA.m

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