IBDFST ;ALB/MAF - FORMS TRACKING STATISTICS - JUL 6 1995
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;
;
EN ; -- main entry point for IBDF FT STATS
D EN^VALM("IBDF FT STATS")
Q
;
HDR ; -- header code
S IBDFX=$P($$FMTE^XLFDT(IBDFBG),"@")
S IBDFY=$P($$FMTE^XLFDT(IBDFEND),"@")
S VALMHDR(1)="Statistical data for the date range of "_IBDFX_" to "_IBDFY
Q
;
;
INIT ; -- init variables and list array
N IBDFDV,IBDFCL,IBDFNODE,IBDCNT,IBDCNT1
S (IBDFDV,IBDFCL,IBDCNT,IBDCNT1,VALMCNT)=0
K IBDF,^TMP("STATS",$J),^TMP("STAIDX",$J)
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)) HEADER D SETARR
Q
;
;
SETARR ; -- Set up Listman array
S IBDCNT1=IBDCNT1+1
S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
S X=""
S IBDFVAL=$$LOWER^VALM1(IBDFCL)
S X=$$SETSTR^VALM1(IBDFVAL,X,1,20)
S IBDFVAL=$J($P(IBDFNODE,"^",1),6)
S X=$$SETSTR^VALM1(IBDFVAL,X,22,6)
S IBDFVAL=$J($P(IBDFNODE,"^",2),5)
S X=$$SETSTR^VALM1(IBDFVAL,X,30,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)
S X=$$SETSTR^VALM1(IBDFVAL,X,37,6)
S IBDFVAL=$J($S($P(IBDFNODE,"^",5)]"":$P(IBDFNODE,"^",5),1:0),5)
S X=$$SETSTR^VALM1(IBDFVAL,X,45,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)
S X=$$SETSTR^VALM1(IBDFVAL,X,52,6)
S IBDFVAL=$J($P(IBDFNODE,"^",3),5)
S X=$$SETSTR^VALM1(IBDFVAL,X,60,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)
S X=$$SETSTR^VALM1(IBDFVAL,X,67,6)
S IBDFVAL=$J($S($P(IBDFNODE,"^",6)]"":$P(IBDFNODE,"^",6),1:0),5)
S X=$$SETSTR^VALM1(IBDFVAL,X,75,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)
S X=$$SETSTR^VALM1(IBDFVAL,X,82,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)
S X=$$SETSTR^VALM1(IBDFVAL,X,90,13)
;
;
TMP ; -- Set up TMP Array
S ^TMP("STATS",$J,IBDCNT,0)=X,^TMP("STATS",$J,"IDX",VALMCNT,IBDCNT1)=""
S ^TMP("STAIDX",$J,IBDCNT1)=VALMCNT
Q
;
;
S IBDCNT1=IBDCNT1+1
S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
S X=""
S IBDF(IBDFDV)=IBDCNT
S X=$$SETSTR^VALM1(" ",X,1,3) D TMP
S X="",IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
S IBDVAL=IBDFDV
S X=$$SETSTR^VALM1(IBDVAL,X,1,25) D TMP,CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
S X="",IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
S X=$$SETSTR^VALM1(" ",X,1,3) D TMP
S IBDCNT1=IBDCNT1-1
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[HIBDFST 3750 printed Apr 09, 2024@20:49:53 Page 2
IBDFST ;ALB/MAF - FORMS TRACKING STATISTICS - JUL 6 1995
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
+3 ;
EN ; -- main entry point for IBDF FT STATS
+1 DO EN^VALM("IBDF FT STATS")
+2 QUIT
+3 ;
HDR ; -- header code
+1 SET IBDFX=$PIECE($$FMTE^XLFDT(IBDFBG),"@")
+2 SET IBDFY=$PIECE($$FMTE^XLFDT(IBDFEND),"@")
+3 SET VALMHDR(1)="Statistical data for the date range of "_IBDFX_" to "_IBDFY
+4 QUIT
+5 ;
+6 ;
INIT ; -- init variables and list array
+1 NEW IBDFDV,IBDFCL,IBDFNODE,IBDCNT,IBDCNT1
+2 SET (IBDFDV,IBDFCL,IBDCNT,IBDCNT1,VALMCNT)=0
+3 KILL IBDF,^TMP("STATS",$JOB),^TMP("STAIDX",$JOB)
+4 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))
DO HEADER
DO SETARR
+5 QUIT
+6 ;
+7 ;
SETARR ; -- Set up Listman array
+1 SET IBDCNT1=IBDCNT1+1
+2 SET IBDCNT=IBDCNT+1
SET VALMCNT=VALMCNT+1
+3 SET X=""
+4 SET IBDFVAL=$$LOWER^VALM1(IBDFCL)
+5 SET X=$$SETSTR^VALM1(IBDFVAL,X,1,20)
+6 SET IBDFVAL=$JUSTIFY($PIECE(IBDFNODE,"^",1),6)
+7 SET X=$$SETSTR^VALM1(IBDFVAL,X,22,6)
+8 SET IBDFVAL=$JUSTIFY($PIECE(IBDFNODE,"^",2),5)
+9 SET X=$$SETSTR^VALM1(IBDFVAL,X,30,5)
+10 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)
+11 SET X=$$SETSTR^VALM1(IBDFVAL,X,37,6)
+12 SET IBDFVAL=$JUSTIFY($SELECT($PIECE(IBDFNODE,"^",5)]"":$PIECE(IBDFNODE,"^",5),1:0),5)
+13 SET X=$$SETSTR^VALM1(IBDFVAL,X,45,5)
+14 IF $PIECE(IBDFNODE,"^",7)
SET IBDFVAL=$PIECE(IBDFNODE,"^",1)-$PIECE(IBDFNODE,"^",7)
+15 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)
+16 SET X=$$SETSTR^VALM1(IBDFVAL,X,52,6)
+17 SET IBDFVAL=$JUSTIFY($PIECE(IBDFNODE,"^",3),5)
+18 SET X=$$SETSTR^VALM1(IBDFVAL,X,60,5)
+19 IF $PIECE(IBDFNODE,"^",7)
SET IBDFVAL=$PIECE(IBDFNODE,"^",1)-$PIECE(IBDFNODE,"^",7)
+20 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)
+21 SET X=$$SETSTR^VALM1(IBDFVAL,X,67,6)
+22 SET IBDFVAL=$JUSTIFY($SELECT($PIECE(IBDFNODE,"^",6)]"":$PIECE(IBDFNODE,"^",6),1:0),5)
+23 SET X=$$SETSTR^VALM1(IBDFVAL,X,75,5)
+24 IF $PIECE(IBDFNODE,"^",7)
SET IBDFVAL=$PIECE(IBDFNODE,"^",1)-$PIECE(IBDFNODE,"^",7)
+25 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)
+26 SET X=$$SETSTR^VALM1(IBDFVAL,X,82,6)
+27 IF $PIECE(IBDFNODE,"^",7)
SET IBDFVAL=$PIECE(IBDFNODE,"^",1)-$PIECE(IBDFNODE,"^",7)
+28 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)
+29 SET X=$$SETSTR^VALM1(IBDFVAL,X,90,13)
+30 ;
+31 ;
TMP ; -- Set up TMP Array
+1 SET ^TMP("STATS",$JOB,IBDCNT,0)=X
SET ^TMP("STATS",$JOB,"IDX",VALMCNT,IBDCNT1)=""
+2 SET ^TMP("STAIDX",$JOB,IBDCNT1)=VALMCNT
+3 QUIT
+4 ;
+5 ;
+1 SET IBDCNT1=IBDCNT1+1
+2 SET IBDCNT=IBDCNT+1
SET VALMCNT=VALMCNT+1
+3 SET X=""
+4 SET IBDF(IBDFDV)=IBDCNT
+5 SET X=$$SETSTR^VALM1(" ",X,1,3)
DO TMP
+6 SET X=""
SET IBDCNT=IBDCNT+1
SET VALMCNT=VALMCNT+1
+7 SET IBDVAL=IBDFDV
+8 SET X=$$SETSTR^VALM1(IBDVAL,X,1,25)
DO TMP
DO CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM,0)
+9 SET X=""
SET IBDCNT=IBDCNT+1
SET VALMCNT=VALMCNT+1
+10 SET X=$$SETSTR^VALM1(" ",X,1,3)
DO TMP
+11 SET IBDCNT1=IBDCNT1-1
+12 QUIT
+13 ;
+14 ;
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 ;
