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