DENTA15A.m

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 ---DENTA15A   1755     printed  Feb 18, 2025@23:12:10                                                                                                                                                                                                    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