ACKQCDD3.m

ACKQCDD3 ;AUG/JLTP BIR/PTD HCIOFO/AG-Generate A&SP Service CDR for Division- 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 HDR1

 I '$O(^TMP("ACKQCDD",$J,"ACKH",0)) D  Q

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

 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))  D

 .S NEWHD=1

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

 ..I $D(^TMP("ACKQCDD",$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("ACKQCDD",$J,"ACKCAT",HD,X1),U),?15,$P(^(X1),U,2)

 ...W ?65,$J(^TMP("ACKQCDD",$J,"ACKH",X1),6,2)

 ...S NEWHD=0

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

 Q

 ;

HDR W @IOF

HDR1 S ACKPG=ACKPG+1

 W "Printed: ",ACKPDT,?(IOM-8),"Page: ",ACKPG,!

 W ! D CNTR^ACKQUTL("Audiology & Speech Pathology")

 W ! D CNTR^ACKQUTL("Cost Distribution Report")

 W ! D CNTR^ACKQUTL("for "_ACKXRNG)

 W ! D CNTR^ACKQUTL("for DIVISION: "_$$DIVNAME(ACKDIV))

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

 Q

 ;

DIVNAME(ACKDIV) ; get division name

 Q $$GET1^DIQ(40.8,ACKDIV_",",.01)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ACKQCDD3   1352     printed  Mar 13, 2025@21:37                                                                                                                                                                                                       Page 2

ACKQCDD3  ;AUG/JLTP BIR/PTD HCIOFO/AG-Generate A&SP Service CDR for Division- 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 HDR1

 +2        IF '$ORDER(^TMP("ACKQCDD",$JOB,"ACKH",0))

               Begin DoDot:1

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

               End DoDot:1

               QUIT 

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

           KILL ACKCAT

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

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

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

 +6        SET (HD,X1)=0

 +7        FOR 

               SET HD=$ORDER(ACKCAT(HD))

               if 'HD!($DATA(DIRUT))

                   QUIT 

               Begin DoDot:1

 +8                SET NEWHD=1

 +9                FOR 

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

                       if 'X1!($DATA(DIRUT))

                           QUIT 

                       Begin DoDot:2

 +10                       IF $DATA(^TMP("ACKQCDD",$JOB,"ACKH",X1))

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

                                   Begin DoDot:3

 +11                                   IF $Y>(IOSL-5)

                                           if $EXTRACT(IOST)="C"

                                               DO PAUSE^ACKQUTL

                                           if $DATA(DIRUT)

                                               QUIT 

                                           DO HDR

                                           WRITE !

 +12                                   IF NEWHD

                                           WRITE !!?5,ACKCAT(HD)

 +13                                   WRITE !?5,$PIECE(^TMP("ACKQCDD",$JOB,"ACKCAT",HD,X1),U),?15,$PIECE(^(X1),U,2)

 +14                                   WRITE ?65,$JUSTIFY(^TMP("ACKQCDD",$JOB,"ACKH",X1),6,2)

 +15                                   SET NEWHD=0

                                   End DoDot:3

                       End DoDot:2

               End DoDot:1

 +16       if '$DATA(DIRUT)

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

 +17       QUIT 

 +18      ;

HDR        WRITE @IOF

HDR1       SET ACKPG=ACKPG+1

 +1        WRITE "Printed: ",ACKPDT,?(IOM-8),"Page: ",ACKPG,!

 +2        WRITE !

           DO CNTR^ACKQUTL("Audiology & Speech Pathology")

 +3        WRITE !

           DO CNTR^ACKQUTL("Cost Distribution Report")

 +4        WRITE !

           DO CNTR^ACKQUTL("for "_ACKXRNG)

 +5        WRITE !

           DO CNTR^ACKQUTL("for DIVISION: "_$$DIVNAME(ACKDIV))

 +6        SET X=""

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

           WRITE !,X

 +7        QUIT 

 +8       ;

DIVNAME(ACKDIV) ; get division name

 +1        QUIT $$GET1^DIQ(40.8,ACKDIV_",",.01)