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 ---[H[J[2J[HACKQCDD3 1352 printed Dec 13, 2024@02:31:59 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)
