source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFST1.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1IBDFST1 ;ALB/MAF - FORMS TRACKING STATISTICS - JUL 6 1995
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3 ;
4 ;
5EN ; -- set up variables
6 N IBPAGE
7 S IBPAGE=0
8 S IBDFX=$P($$FMTE^XLFDT(IBDFBG),"@")
9 S IBDFY=$P($$FMTE^XLFDT(IBDFEND),"@")
10 ;
11INIT ; -- init variables and list array
12 N IBDFDV,IBDFCL,IBDFNODE,IBDCNT,IBDCNT1
13 S (IBDFDV,IBDFCL,IBDCNT,IBDCNT1,VALMCNT)=0
14 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
15 Q
16 ;
17 ;
18SETARR ; -- Set up Listman array
19 S IBDCNT1=IBDCNT1+1
20 S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
21 S IBDFVAL=$$LOWER^VALM1(IBDFCL)
22 W !,$E(IBDFVAL,1,20)
23 S IBDFVAL=$J($P(IBDFNODE,"^",1),6)
24 W ?22,$E(IBDFVAL,1,6)
25 S IBDFVAL=$J($P(IBDFNODE,"^",2),5)
26 W ?30,$E(IBDFVAL,1,5)
27 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)
28 W ?37,$E(IBDFVAL,1,6)
29 S IBDFVAL=$J($S($P(IBDFNODE,"^",5)]"":$P(IBDFNODE,"^",5),1:0),5)
30 W ?45,$E(IBDFVAL,1,5)
31 I $P(IBDFNODE,"^",7) S IBDFVAL=$P(IBDFNODE,"^",1)-$P(IBDFNODE,"^",7)
32 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)
33 W ?52,$E(IBDFVAL,1,6)
34 S IBDFVAL=$J($P(IBDFNODE,"^",3),5)
35 W ?60,$E(IBDFVAL,1,5)
36 I $P(IBDFNODE,"^",7) S IBDFVAL=$P(IBDFNODE,"^",1)-$P(IBDFNODE,"^",7)
37 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)
38 W ?67,$E(IBDFVAL,1,6)
39 S IBDFVAL=$J($S($P(IBDFNODE,"^",6)]"":$P(IBDFNODE,"^",6),1:0),5)
40 W ?75,$E(IBDFVAL,1,5)
41 I $P(IBDFNODE,"^",7) S IBDFVAL=$P(IBDFNODE,"^",1)-$P(IBDFNODE,"^",7)
42 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)
43 W ?82,$E(IBDFVAL,1,6)
44 I $P(IBDFNODE,"^",7) S IBDFVAL=$P(IBDFNODE,"^",1)-$P(IBDFNODE,"^",7)
45 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)
46 W ?90,$E(IBDFVAL,1,13)
47 Q
48 ;
49 ;
50HEADER ; -- Set up header line for the display
51 S IBDCNT1=IBDCNT1+1
52 S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
53 S IBDF(IBDFDV)=IBDCNT
54 W !," "
55 S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
56 S IBDVAL=IBDFDV
57 W !,$E(IBDVAL,1,25)
58 S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
59 W !," "
60 S IBDCNT1=IBDCNT1-1
61 Q
62 ;
63 ;
64HDR S IBPAGE=IBPAGE+1 W @IOF,"Statistics Report",?55,IBDFY,?110,"PAGE: ",IBPAGE
65 S X="",$P(X,"=",133)="" W !,X
66 W !,"Statistical data for the date range of "_IBDFX_" to "_IBDFY,!
67 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"
68 S X="",$P(X,"-",133)="" W !,X
69 Q
70HELP ; -- help code
71 S X="?" D DISP^XQORM1 W !!
72 Q
73 ;
74 ;
75EXIT ; -- exit code
76 K IBDF,IBDFX,IBDFY,^TMP("STATS",$J),^TMP("STAIDX",$J)
77 Q
78 ;
79 ;
80EXPND ; -- expand code
81 Q
82 ;
Note: See TracBrowser for help on using the repository browser.