- 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 Jan 18, 2025@03:33:05 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