source: WorldVistAEHR/trunk/r/DENTAL-DEN/DENTA15A.m@ 1093

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

initial load of WorldVistAEHR
File size: 1.7 KB
RevLine 
[613]1DENTA15A ;ISC2/HCD,SAW-PRINT/DISPLAY TREATMENT DATA SUMMARY REPORTS BY CLINIC OR PROVIDER(CON'T) ;4/28/89 14:19 ;
2 ;VERSION 1.2
3 S (A1,A2,A3,A4,A5,A6,A7,A8,AB,H4,H6,X,Z5)="",V=$S(DENT4=1:"$VALUE",1:""),V1=$S(DENT4=1:"TOT $VALUE",1:""),H8=1 D HDR^DENTA15,HDR3,A4,A5 K H8 Q
4A4 F I=0:0 D:$Y#(IOSL-3)=0 HOLD1 Q:Z5=U S X=$O(^UTILITY($J,"DENTR",X)) Q:X="" S (A5,X1)="",A0=^DIC(220.3,X,0),A1=$P(A0,U,2),A6=$P(A0,U,3) D A41
5 Q
6A41 F J=0:0 S X1=$O(^UTILITY($J,"DENTR",X,X1)) D:X1="" A4P Q:X1="" S X2=^(X1),A5=A5+X2 I X=18,+X2>0 S F=1,AB=AB+(A1*$P(X2,"^",2))+(+X2-$P(X2,"^",2))
7 Q
8A5 D:$Y#(IOSL-3)=0 HOLD1 Q:Z5=U W !!,"Totals",?35,$J(A4,4),?56,$J(A3,10,2) W:DENT4=1 ?67,$J(A8,11,2) W !!,"Note: This report is used to verify the 240 and 280 report."
9 D:$Y>(IOSL-3) HOLD1 Q:Z5=U W:$D(F)&$D(DENT3) !,?4," Total CTVs for extractions are weighted (calculated) as follows: ",!,?6,"4 CTVs for the first extraction 1 CTV for each additional extraction.",! K F D HOLD^DENTA15 Q
10HDR3 W !!,"PROCEDURE",?33,"# DONE",?43,"CTV",?50,V,?59,"TOT CTV",?68,V1 Q
11A4P S A4=A4+A5,A2=A2+A1,A7=A7+A6,A8=A8+(A6*A5) W !,$E($P(A0,U,1),1,30),?35,$J(A5,4),?40,$J(A1,6,2) W:DENT4=1 ?47,$J(A6,9,2) S A1=A5*A1 S:(X=18)&(+X2>0) A1=AB S A3=A3+A1 W ?57,$J(A1,9,2) W:DENT4=1 ?67,$J(A6*A5,11,2) Q
12A6 S (A1,A2,A3,A4,A5,A6,A7,A8,AB,H4,X)="",V=$S(DENT4=1:"$VALUE",1:""),V1=$S(DENT4=1:"TOT $VALUE",1:""),H8=1 D HDR^DENTA15,HDR3,A7,A5 K H8 Q
13A7 F I=0:0 S X=$O(^UTILITY($J,"DENTR",DENTPRV,X)) Q:X="" S:X=18 F=1 S (A5,X1)="",A0=^DIC(220.3,X,0),A1=$P(A0,U,2),A6=$P(A0,U,3) D A9
14 Q
15A9 F J=0:0 S X1=$O(^UTILITY($J,"DENTR",DENTPRV,X,X1)) D:X1="" A4P Q:X1="" S X2=^(X1),A5=A5+X2 I X=18,+X2>0 S AB=AB+(A1*$P(X2,"^",2))+(+X2-$P(X2,"^",2))
16 Q
17HOLD1 D HOLD^DENTA15 D:Z5'=U HDR^DENTA15,HDR3 Q
Note: See TracBrowser for help on using the repository browser.