IBDFST1 ;ALB/MAF - FORMS TRACKING STATISTICS - JUL 6 1995
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;
;
EN ; -- set up variables
N IBPAGE
S IBPAGE=0
S IBDFX=$P($$FMTE^XLFDT(IBDFBG),"@")
S IBDFY=$P($$FMTE^XLFDT(IBDFEND),"@")
;
INIT ; -- init variables and list array
N IBDFDV,IBDFCL,IBDFNODE,IBDCNT,IBDCNT1
S (IBDFDV,IBDFCL,IBDCNT,IBDCNT1,VALMCNT)=0
F IBDFDIV=0:0 S IBDFDV=$O(^TMP("CNT",$J,IBDFDV)) Q:IBDFDV']"" F IBDFCLI=0:0 S IBDFCL=$O(^TMP("CNT",$J,IBDFDV,IBDFCL)) Q:IBDFCL']"" S IBDFNODE=^TMP("CNT",$J,IBDFDV,IBDFCL) D:'$D(IBDF(IBDFDV))!($Y+6>IOSL) HDR,HEADER D SETARR
Q
;
;
SETARR ; -- Set up Listman array
S IBDCNT1=IBDCNT1+1
S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
S IBDFVAL=$$LOWER^VALM1(IBDFCL)
W !,$E(IBDFVAL,1,20)
S IBDFVAL=$J($P(IBDFNODE,"^",1),6)
W ?22,$E(IBDFVAL,1,6)
S IBDFVAL=$J($P(IBDFNODE,"^",2),5)
W ?30,$E(IBDFVAL,1,5)
S IBDFVAL=$J($S(+$P(IBDFNODE,"^",1)>0:($P(IBDFNODE,"^",2)/$P(IBDFNODE,"^",1))*100,1:0),6) I IBDFVAL>0 S IBDFVAL=$J($P(IBDFVAL,".",1)_"."_$E($P(IBDFVAL,".",2),1,2),6)
W ?37,$E(IBDFVAL,1,6)
S IBDFVAL=$J($S($P(IBDFNODE,"^",5)]"":$P(IBDFNODE,"^",5),1:0),5)
W ?45,$E(IBDFVAL,1,5)
I $P(IBDFNODE,"^",7) S IBDFVAL=$P(IBDFNODE,"^",1)-$P(IBDFNODE,"^",7)
S IBDFVAL=$J($S(+$P(IBDFNODE,"^",7)>0&(IBDFVAL>0):(+$P(IBDFNODE,"^",5)/IBDFVAL)*100,+$P(IBDFNODE,"^",7)'>0:(+$P(IBDFNODE,"^",5)/$P(IBDFNODE,"^",1))*100,1:0),6) I IBDFVAL>0 S IBDFVAL=$J($P(IBDFVAL,".",1)_"."_$E($P(IBDFVAL,".",2),1,2),6)
W ?52,$E(IBDFVAL,1,6)
S IBDFVAL=$J($P(IBDFNODE,"^",3),5)
W ?60,$E(IBDFVAL,1,5)
I $P(IBDFNODE,"^",7) S IBDFVAL=$P(IBDFNODE,"^",1)-$P(IBDFNODE,"^",7)
S IBDFVAL=$J($S(+$P(IBDFNODE,"^",7)>0&(IBDFVAL>0):($P(IBDFNODE,"^",3)/IBDFVAL)*100,+$P(IBDFNODE,"^",7)'>0:(+$P(IBDFNODE,"^",3)/$P(IBDFNODE,"^",1))*100,1:0),6) I IBDFVAL>0 S IBDFVAL=$J($P(IBDFVAL,".",1)_"."_$E($P(IBDFVAL,".",2),1,2),6)
W ?67,$E(IBDFVAL,1,6)
S IBDFVAL=$J($S($P(IBDFNODE,"^",6)]"":$P(IBDFNODE,"^",6),1:0),5)
W ?75,$E(IBDFVAL,1,5)
I $P(IBDFNODE,"^",7) S IBDFVAL=$P(IBDFNODE,"^",1)-$P(IBDFNODE,"^",7)
S IBDFVAL=$J($S(+$P(IBDFNODE,"^",7)>0&(IBDFVAL>0):($P(IBDFNODE,"^",6)/IBDFVAL)*100,+$P(IBDFNODE,"^",7)'>0:($P(IBDFNODE,"^",6)/$P(IBDFNODE,"^",1))*100,1:0),6) I IBDFVAL>0 S IBDFVAL=$J($P(IBDFVAL,".",1)_"."_$E($P(IBDFVAL,".",2),1,2),6)
W ?82,$E(IBDFVAL,1,6)
I $P(IBDFNODE,"^",7) S IBDFVAL=$P(IBDFNODE,"^",1)-$P(IBDFNODE,"^",7)
S IBDFVAL=$J($S(+$P(IBDFNODE,"^",7)>0&(IBDFVAL>0):($P(IBDFNODE,"^",4)/IBDFVAL),+$P(IBDFNODE,"^",7)'>0:($P(IBDFNODE,"^",4)/$P(IBDFNODE,"^",1)),1:0),13) I IBDFVAL>0 S IBDFVAL=$J($P(IBDFVAL,".",1)_"."_$E($P(IBDFVAL,".",2),1,2),13)
W ?90,$E(IBDFVAL,1,13)
Q
;
;
S IBDCNT1=IBDCNT1+1
S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
S IBDF(IBDFDV)=IBDCNT
W !," "
S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
S IBDVAL=IBDFDV
W !,$E(IBDVAL,1,25)
S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
W !," "
S IBDCNT1=IBDCNT1-1
Q
;
;
HDR S IBPAGE=IBPAGE+1 W @IOF,"Statistics Report",?55,IBDFY,?110,"PAGE: ",IBPAGE
S X="",$P(X,"=",133)="" W !,X
W !,"Statistical data for the date range of "_IBDFX_" to "_IBDFY,!
W !,?5,"CLINIC/PATIENT",?22,"TOTAL",?30,"#PRNT",?37,"%PRNTD",?47,"#DE",?55,"%DE",?60,"#SCND",?67,"%SCND",?75,"#PCE",?83,"%PCE",?90,"AVG DAYS SCND"
S X="",$P(X,"-",133)="" W !,X
Q
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
;
EXIT ; -- exit code
K IBDF,IBDFX,IBDFY,^TMP("STATS",$J),^TMP("STAIDX",$J)
Q
;
;
EXPND ; -- expand code
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFST1 3519 printed Apr 09, 2024@20:59:17 Page 2
IBDFST1 ;ALB/MAF - FORMS TRACKING STATISTICS - JUL 6 1995
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
+3 ;
EN ; -- set up variables
+1 NEW IBPAGE
+2 SET IBPAGE=0
+3 SET IBDFX=$PIECE($$FMTE^XLFDT(IBDFBG),"@")
+4 SET IBDFY=$PIECE($$FMTE^XLFDT(IBDFEND),"@")
+5 ;
INIT ; -- init variables and list array
+1 NEW IBDFDV,IBDFCL,IBDFNODE,IBDCNT,IBDCNT1
+2 SET (IBDFDV,IBDFCL,IBDCNT,IBDCNT1,VALMCNT)=0
+3 FOR IBDFDIV=0:0
SET IBDFDV=$ORDER(^TMP("CNT",$JOB,IBDFDV))
if IBDFDV']""
QUIT
FOR IBDFCLI=0:0
SET IBDFCL=$ORDER(^TMP("CNT",$JOB,IBDFDV,IBDFCL))
if IBDFCL']""
QUIT
SET IBDFNODE=^TMP("CNT",$JOB,IBDFDV,IBDFCL)
if '$DATA(IBDF(IBDFDV))!($Y+6>IOSL)
DO HDR
DO HEADER
DO SETARR
+4 QUIT
+5 ;
+6 ;
SETARR ; -- Set up Listman array
+1 SET IBDCNT1=IBDCNT1+1
+2 SET IBDCNT=IBDCNT+1
SET VALMCNT=VALMCNT+1
+3 SET IBDFVAL=$$LOWER^VALM1(IBDFCL)
+4 WRITE !,$EXTRACT(IBDFVAL,1,20)
+5 SET IBDFVAL=$JUSTIFY($PIECE(IBDFNODE,"^",1),6)
+6 WRITE ?22,$EXTRACT(IBDFVAL,1,6)
+7 SET IBDFVAL=$JUSTIFY($PIECE(IBDFNODE,"^",2),5)
+8 WRITE ?30,$EXTRACT(IBDFVAL,1,5)
+9 SET IBDFVAL=$JUSTIFY($SELECT(+$PIECE(IBDFNODE,"^",1)>0:($PIECE(IBDFNODE,"^",2)/$PIECE(IBDFNODE,"^",1))*100,1:0),6)
IF IBDFVAL>0
SET IBDFVAL=$JUSTIFY($PIECE(IBDFVAL,".",1)_"."_$EXTRACT($PIECE(IBDFVAL,".",2),1,2),6)
+10 WRITE ?37,$EXTRACT(IBDFVAL,1,6)
+11 SET IBDFVAL=$JUSTIFY($SELECT($PIECE(IBDFNODE,"^",5)]"":$PIECE(IBDFNODE,"^",5),1:0),5)
+12 WRITE ?45,$EXTRACT(IBDFVAL,1,5)
+13 IF $PIECE(IBDFNODE,"^",7)
SET IBDFVAL=$PIECE(IBDFNODE,"^",1)-$PIECE(IBDFNODE,"^",7)
+14 SET IBDFVAL=$JUSTIFY($SELECT(+$PIECE(IBDFNODE,"^",7)>0&(IBDFVAL>0):(+$PIECE(IBDFNODE,"^",5)/IBDFVAL)*100,+$PIECE(IBDFNODE,"^",7)'>0:(+$PIECE(IBDFNODE,"^",5)/$PIECE(IBDFNODE,"^",1))*100,1:0),6)
IF IBDFVAL>0
SET IBDFVAL=$JUSTIFY($PIECE(IBDFVAL,".",1)_"."_$EXTRACT($PIECE(IBDFVAL,".",2),1,2),6)
+15 WRITE ?52,$EXTRACT(IBDFVAL,1,6)
+16 SET IBDFVAL=$JUSTIFY($PIECE(IBDFNODE,"^",3),5)
+17 WRITE ?60,$EXTRACT(IBDFVAL,1,5)
+18 IF $PIECE(IBDFNODE,"^",7)
SET IBDFVAL=$PIECE(IBDFNODE,"^",1)-$PIECE(IBDFNODE,"^",7)
+19 SET IBDFVAL=$JUSTIFY($SELECT(+$PIECE(IBDFNODE,"^",7)>0&(IBDFVAL>0):($PIECE(IBDFNODE,"^",3)/IBDFVAL)*100,+$PIECE(IBDFNODE,"^",7)'>0:(+$PIECE(IBDFNODE,"^",3)/$PIECE(IBDFNODE,"^",1))*100,1:0),6)
IF IBDFVAL>0
SET IBDFVAL=$JUSTIFY($PIECE(IBDFVAL,".",1)_"."_$EXTRACT($PIECE(IBDFVAL,".",2),1,2),6)
+20 WRITE ?67,$EXTRACT(IBDFVAL,1,6)
+21 SET IBDFVAL=$JUSTIFY($SELECT($PIECE(IBDFNODE,"^",6)]"":$PIECE(IBDFNODE,"^",6),1:0),5)
+22 WRITE ?75,$EXTRACT(IBDFVAL,1,5)
+23 IF $PIECE(IBDFNODE,"^",7)
SET IBDFVAL=$PIECE(IBDFNODE,"^",1)-$PIECE(IBDFNODE,"^",7)
+24 SET IBDFVAL=$JUSTIFY($SELECT(+$PIECE(IBDFNODE,"^",7)>0&(IBDFVAL>0):($PIECE(IBDFNODE,"^",6)/IBDFVAL)*100,+$PIECE(IBDFNODE,"^",7)'>0:($PIECE(IBDFNODE,"^",6)/$PIECE(IBDFNODE,"^",1))*100,1:0),6)
IF IBDFVAL>0
SET IBDFVAL=$JUSTIFY($PIECE(IBDFVAL,".",1)_"."_$EXTRACT($PIECE(IBDFVAL,".",2),1,2),6)
+25 WRITE ?82,$EXTRACT(IBDFVAL,1,6)
+26 IF $PIECE(IBDFNODE,"^",7)
SET IBDFVAL=$PIECE(IBDFNODE,"^",1)-$PIECE(IBDFNODE,"^",7)
+27 SET IBDFVAL=$JUSTIFY($SELECT(+$PIECE(IBDFNODE,"^",7)>0&(IBDFVAL>0):($PIECE(IBDFNODE,"^",4)/IBDFVAL),+$PIECE(IBDFNODE,"^",7)'>0:($PIECE(IBDFNODE,"^",4)/$PIECE(IBDFNODE,"^",1)),1:0),13)
IF IBDFVAL>0
SET IBDFVAL=$JUSTIFY($PIECE(IBDFVAL,".",1)_"."_$EXTRACT($PIECE(IBDFVAL,".",2),1,2),13)
+28 WRITE ?90,$EXTRACT(IBDFVAL,1,13)
+29 QUIT
+30 ;
+31 ;
+1 SET IBDCNT1=IBDCNT1+1
+2 SET IBDCNT=IBDCNT+1
SET VALMCNT=VALMCNT+1
+3 SET IBDF(IBDFDV)=IBDCNT
+4 WRITE !," "
+5 SET IBDCNT=IBDCNT+1
SET VALMCNT=VALMCNT+1
+6 SET IBDVAL=IBDFDV
+7 WRITE !,$EXTRACT(IBDVAL,1,25)
+8 SET IBDCNT=IBDCNT+1
SET VALMCNT=VALMCNT+1
+9 WRITE !," "
+10 SET IBDCNT1=IBDCNT1-1
+11 QUIT
+12 ;
+13 ;
HDR SET IBPAGE=IBPAGE+1
WRITE @IOF,"Statistics Report",?55,IBDFY,?110,"PAGE: ",IBPAGE
+1 SET X=""
SET $PIECE(X,"=",133)=""
WRITE !,X
+2 WRITE !,"Statistical data for the date range of "_IBDFX_" to "_IBDFY,!
+3 WRITE !,?5,"CLINIC/PATIENT",?22,"TOTAL",?30,"#PRNT",?37,"%PRNTD",?47,"#DE",?55,"%DE",?60,"#SCND",?67,"%SCND",?75,"#PCE",?83,"%PCE",?90,"AVG DAYS SCND"
+4 SET X=""
SET $PIECE(X,"-",133)=""
WRITE !,X
+5 QUIT
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
+4 ;
EXIT ; -- exit code
+1 KILL IBDF,IBDFX,IBDFY,^TMP("STATS",$JOB),^TMP("STAIDX",$JOB)
+2 QUIT
+3 ;
+4 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
