DENTA15A ;ISC2/HCD,SAW-PRINT/DISPLAY TREATMENT DATA SUMMARY REPORTS BY CLINIC OR PROVIDER(CON'T) ;4/28/89 14:19 ;
;VERSION 1.2
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
A4 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
Q
A41 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))
Q
A5 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."
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
HDR3 W !!,"PROCEDURE",?33,"# DONE",?43,"CTV",?50,V,?59,"TOT CTV",?68,V1 Q
A4P 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
A6 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
A7 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
Q
A9 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))
Q
HOLD1 D HOLD^DENTA15 D:Z5'=U HDR^DENTA15,HDR3 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTA15A 1755 printed Dec 13, 2024@01:45:48 Page 2
DENTA15A ;ISC2/HCD,SAW-PRINT/DISPLAY TREATMENT DATA SUMMARY REPORTS BY CLINIC OR PROVIDER(CON'T) ;4/28/89 14:19 ;
+1 ;VERSION 1.2
+2 SET (A1,A2,A3,A4,A5,A6,A7,A8,AB,H4,H6,X,Z5)=""
SET V=$SELECT(DENT4=1:"$VALUE",1:"")
SET V1=$SELECT(DENT4=1:"TOT $VALUE",1:"")
SET H8=1
DO HDR^DENTA15
DO HDR3
DO A4
DO A5
KILL H8
QUIT
A4 FOR I=0:0
if $Y#(IOSL-3)=0
DO HOLD1
if Z5=U
QUIT
SET X=$ORDER(^UTILITY($JOB,"DENTR",X))
if X=""
QUIT
SET (A5,X1)=""
SET A0=^DIC(220.3,X,0)
SET A1=$PIECE(A0,U,2)
SET A6=$PIECE(A0,U,3)
DO A41
+1 QUIT
A41 FOR J=0:0
SET X1=$ORDER(^UTILITY($JOB,"DENTR",X,X1))
if X1=""
DO A4P
if X1=""
QUIT
SET X2=^(X1)
SET A5=A5+X2
IF X=18
IF +X2>0
SET F=1
SET AB=AB+(A1*$PIECE(X2,"^",2))+(+X2-$PIECE(X2,"^",2))
+1 QUIT
A5 if $Y#(IOSL-3)=0
DO HOLD1
if Z5=U
QUIT
WRITE !!,"Totals",?35,$JUSTIFY(A4,4),?56,$JUSTIFY(A3,10,2)
if DENT4=1
WRITE ?67,$JUSTIFY(A8,11,2)
WRITE !!,"Note: This report is used to verify the 240 and 280 report."
+1 if $Y>(IOSL-3)
DO HOLD1
if Z5=U
QUIT
if $DATA(F)&$DATA(DENT3)
WRITE !,?4," Total CTVs for extractions are weighted (calculated) as follows: ",!,?6,"4 CTVs for the first extraction 1 CTV for each additional extraction.",!
KILL F
DO HOLD^DENTA15
QUIT
HDR3 WRITE !!,"PROCEDURE",?33,"# DONE",?43,"CTV",?50,V,?59,"TOT CTV",?68,V1
QUIT
A4P SET A4=A4+A5
SET A2=A2+A1
SET A7=A7+A6
SET A8=A8+(A6*A5)
WRITE !,$EXTRACT($PIECE(A0,U,1),1,30),?35,$JUSTIFY(A5,4),?40,$JUSTIFY(A1,6,2)
if DENT4=1
WRITE ?47,$JUSTIFY(A6,9,2)
SET A1=A5*A1
if (X=18)&(+X2>0)
SET A1=AB
SET A3=A3+A1
WRITE ?57,$JUSTIFY(A1,9,2)
if DENT4=1
WRITE ?67,$JUSTIFY(A6*A5,11,2)
QUIT
A6 SET (A1,A2,A3,A4,A5,A6,A7,A8,AB,H4,X)=""
SET V=$SELECT(DENT4=1:"$VALUE",1:"")
SET V1=$SELECT(DENT4=1:"TOT $VALUE",1:"")
SET H8=1
DO HDR^DENTA15
DO HDR3
DO A7
DO A5
KILL H8
QUIT
A7 FOR I=0:0
SET X=$ORDER(^UTILITY($JOB,"DENTR",DENTPRV,X))
if X=""
QUIT
if X=18
SET F=1
SET (A5,X1)=""
SET A0=^DIC(220.3,X,0)
SET A1=$PIECE(A0,U,2)
SET A6=$PIECE(A0,U,3)
DO A9
+1 QUIT
A9 FOR J=0:0
SET X1=$ORDER(^UTILITY($JOB,"DENTR",DENTPRV,X,X1))
if X1=""
DO A4P
if X1=""
QUIT
SET X2=^(X1)
SET A5=A5+X2
IF X=18
IF +X2>0
SET AB=AB+(A1*$PIECE(X2,"^",2))+(+X2-$PIECE(X2,"^",2))
+1 QUIT
HOLD1 DO HOLD^DENTA15
if Z5'=U
DO HDR^DENTA15
DO HDR3
QUIT
