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 ---[H[J[2J[HACKQCD3 1116 printed Dec 13, 2024@02:31:55 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
