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

BSDLCA1.m

Go to the documentation of this file. 
  1. BSDLCA1 ; IHS/ANMC/LJF - CLERK WHO MADE APPT TOTALS ; [ 03/01/2004  2:16 PM ]
  1.  ;;5.3;PIMS;;APR 26, 2002
  1.  ;
  1. EN ;EP; -- main entry point for SD IHS APPT MADE BY
  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 STATS")
  1.  D CLEAR^VALM1,EXIT Q
  1.  ;
  1. HDR ;EP; -- header code
  1.  S VALMHDR(1)=$$SP(25)_$$RANGE^BDGF(BSDBDT,BSDEDT)
  1.  Q
  1.  ;
  1. INIT ; -- gather data
  1.  NEW SD,SC
  1.  K ^TMP("BSDLCA",$J),^TMP("BSDLCA1",$J)
  1.  I VAUTC D ALL,DISPLAY Q
  1.  S SD=""
  1.  F  S SD=$O(VAUTC(SD)) Q:SD=""  S SC=VAUTC(SD) Q:'SC  D 1
  1.  D DISPLAY
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K ^TMP("BSDLCA",$J),^TMP("BSDLCA1",$J)
  1.  K VALMBCK,VALMCNT,VALMHDR,BSDLN,BSDTYP,BSDBDT,BSDEDT,VAUTC,VAUTD,%DT
  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 1
  1.  Q
  1.  ;
  1. 1 ; -- loop clinics
  1.  NEW DATE,PAT,NODE,CLN,USR,COUNT,NM
  1.  S CLN=$P(^SC(+SC,0),U)
  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.  .. S USR=$P(NODE,U,6),NM=$S(USR="":"UNKNOWN",1:$P(^VA(200,USR,0),U))
  1.  .. S COUNT=$G(COUNT)+1 ;increment total appts
  1.  .. S ^TMP("BSDLCA1",$J,CLN,NM,+USR)=$G(^TMP("BSDLCA1",$J,CLN,NM,+USR))+1
  1.  ;IHS/ITSC/WAR 3/1/04 Don't write rec unless there is a count
  1.  ;S ^TMP("BSDLCA1",$J,CLN)=$G(COUNT)
  1.  I +$G(COUNT) S ^TMP("BSDLCA1",$J,CLN)=$G(COUNT)
  1.  Q
  1.  ;
  1. DISPLAY ; -- create ^tmp for list template display
  1.  NEW CLN,NM,USR,LINE,TOTAL,NUM
  1.  K ^TMP("BSDLCA",$J) S BSDLN=0
  1.  S CLN=0 F  S CLN=$O(^TMP("BSDLCA1",$J,CLN)) Q:CLN=""  D
  1.  . ; set line with clinic name
  1.  . S TOTAL=^TMP("BSDLCA1",$J,CLN),LINE=" "_$$PAD(CLN,49)_$J(+TOTAL,4)
  1.  . D SET(LINE)
  1.  . ;
  1.  . ; loop thru users and give counts
  1.  . S NM=0 F  S NM=$O(^TMP("BSDLCA1",$J,CLN,NM)) Q:NM=""  D
  1.  .. S USR="" F  S USR=$O(^TMP("BSDLCA1",$J,CLN,NM,USR)) Q:USR=""  D
  1.  ... S NUM=^TMP("BSDLCA1",$J,CLN,NM,USR)  ;# of appt by user
  1.  ... S LINE=$$SP(25)_$$PAD(NM,25)_$$PAD($J(NUM,4),15)
  1.  ... S LINE=LINE_$$PERCENT(NUM,TOTAL)
  1.  ... D SET(LINE)
  1.  . D SET(" ")
  1.  S VALMCNT=BSDLN
  1.  Q
  1.  ;
  1. SET(DATA) ; -- sets ^tmp with display line
  1.  S BSDLN=$G(BSDLN)+1
  1.  S ^TMP("BSDLCA",$J,BSDLN,0)=DATA
  1.  S ^TMP("BSDLCA",$J,"IDX",BSDLN,BSDLN)=""
  1.  Q
  1.  ;
  1. PERCENT(X,Y) ; -- returns % of y in x
  1.  Q $J(X/Y*100,5,0)_"%"
  1.  ;
  1. PRINT ; -- prints list to paper
  1.  NEW BSDLN
  1.  U IO D HD(0)
  1.  S BSDLN=0 F  S BSDLN=$O(^TMP("BSDLCA",$J,BSDLN)) Q:'BSDLN  D
  1.  . I $Y>(IOSL-4) D HD(1)
  1.  . W !,^TMP("BSDLCA",$J,BSDLN,0)
  1.  D ^%ZISC
  1.  Q
  1.  ;
  1. HD(X) ; -- heading
  1.  W:X @IOF W !!,?27,"NUMBER OF APPTS MADE BY USERS",!
  1.  W !?1,"Clinic Name",?25,"User Name",?47,"# of Appts Made"
  1.  W ?65,"% of Total",!,$$REPEAT^XLFSTR("=",79),!
  1.  Q
  1.  ;
  1. D(Y) ; -- date
  1.  NEW N,P,D
  1.  X ^DD("DD") Q Y
  1.  ;
  1. AGE(X) ; -- age
  1.  NEW N,D,P
  1.  Q $$GET1^DIQ(9000001,X,1102.98)
  1.  ;
  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)
  1.  ;