ACKQCD3.m

ACKQCD3 ;AUG/JLTP BIR/PTD-Generate A&SP Service CDR - CONTINUED ; [ 12/07/95   9:52 AM ]

 ;;3.0;QUASAR;;Feb 11, 2000

 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.

PRINT ;

 D HDR I '$O(^TMP("ACKQCDR",$J,"ACKH",0)) W !!,"No data found for report specifications." Q

 D FIELD^DID(509850,3,"","POINTER","X") K ACKCAT

 F I=1:1:($L(X("POINTER"),";")-1) S Y=$P(X("POINTER"),";",I),ACKCAT($P(Y,":"))=$P(Y,":",2)

 S (HD,X1)=0

 F  S HD=$O(ACKCAT(HD)) Q:'HD!($D(DIRUT))  S NEWHD=1 F  S X1=$O(^TMP("ACKQCDR",$J,"ACKCAT",HD,X1)) Q:'X1!($D(DIRUT))  D

 .I $D(^TMP("ACKQCDR",$J,"ACKH",X1)),($P(^(X1),U)>0) D

 ..I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)  D HDR W !

 ..I NEWHD W !!?5,ACKCAT(HD)

 ..W !?5,$P(^TMP("ACKQCDR",$J,"ACKCAT",HD,X1),U),?15,$P(^(X1),U,2),?65,$J(^TMP("ACKQCDR",$J,"ACKH",X1),6,2)

 ..S NEWHD=0

 W:'$D(DIRUT) !!?55,"Total:",?65,$J(ACKTP,6,2),"%"

 Q

HDR ;

 S ACKPG=ACKPG+1 W @IOF,"Printed: ",ACKPDT,?(IOM-8),"Page: ",ACKPG,!

 F X="Audiology & Speech Pathology","Cost Distribution Report","for",ACKXRNG W ! D CNTR^ACKQUTL(X)

 S X="",$P(X,"-",IOM)="-" W !,X

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ACKQCD3   1116     printed  Apr 09, 2024@21:34:18                                                                                                                                                                                                     Page 2

ACKQCD3   ;AUG/JLTP BIR/PTD-Generate A&SP Service CDR - CONTINUED ; [ 12/07/95   9:52 AM ]

 +1       ;;3.0;QUASAR;;Feb 11, 2000

 +2       ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.

PRINT     ;

 +1        DO HDR

           IF '$ORDER(^TMP("ACKQCDR",$JOB,"ACKH",0))

               WRITE !!,"No data found for report specifications."

               QUIT 

 +2        DO FIELD^DID(509850,3,"","POINTER","X")

           KILL ACKCAT

 +3        FOR I=1:1:($LENGTH(X("POINTER"),";")-1)

               SET Y=$PIECE(X("POINTER"),";",I)

               SET ACKCAT($PIECE(Y,":"))=$PIECE(Y,":",2)

 +4        SET (HD,X1)=0

 +5        FOR 

               SET HD=$ORDER(ACKCAT(HD))

               if 'HD!($DATA(DIRUT))

                   QUIT 

               SET NEWHD=1

               FOR 

                   SET X1=$ORDER(^TMP("ACKQCDR",$JOB,"ACKCAT",HD,X1))

                   if 'X1!($DATA(DIRUT))

                       QUIT 

                   Begin DoDot:1

 +6                    IF $DATA(^TMP("ACKQCDR",$JOB,"ACKH",X1))

                           IF ($PIECE(^(X1),U)>0)

                               Begin DoDot:2

 +7                                IF $Y>(IOSL-5)

                                       if $EXTRACT(IOST)="C"

                                           DO PAUSE^ACKQUTL

                                       if $DATA(DIRUT)

                                           QUIT 

                                       DO HDR

                                       WRITE !

 +8                                IF NEWHD

                                       WRITE !!?5,ACKCAT(HD)

 +9                                WRITE !?5,$PIECE(^TMP("ACKQCDR",$JOB,"ACKCAT",HD,X1),U),?15,$PIECE(^(X1),U,2),?65,$JUSTIFY(^TMP("ACKQCDR",$JOB,"ACKH",X1),6,2)

 +10                               SET NEWHD=0

                               End DoDot:2

                   End DoDot:1

 +11       if '$DATA(DIRUT)

               WRITE !!?55,"Total:",?65,$JUSTIFY(ACKTP,6,2),"%"

 +12       QUIT 

HDR       ;

 +1        SET ACKPG=ACKPG+1

           WRITE @IOF,"Printed: ",ACKPDT,?(IOM-8),"Page: ",ACKPG,!

 +2        FOR X="Audiology & Speech Pathology","Cost Distribution Report","for",ACKXRNG

               WRITE !

               DO CNTR^ACKQUTL(X)

 +3        SET X=""

           SET $PIECE(X,"-",IOM)="-"

           WRITE !,X

 +4        QUIT