IBDFST.m

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

 ;

 ;

HEADER ;  -- Set up header line for the display

 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

 ;

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       ;

HEADER    ;  -- Set up header line for the display

 +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       ;