| 1 | ACKQCDD3 ;AUG/JLTP BIR/PTD HCIOFO/AG-Generate A&SP Service CDR for Division- CONTINUED ; [ 12/07/95 9:52 AM ]
|
|---|
| 2 | ;;3.0;QUASAR;;Feb 11, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
|---|
| 4 | PRINT ;
|
|---|
| 5 | D HDR1
|
|---|
| 6 | I '$O(^TMP("ACKQCDD",$J,"ACKH",0)) D Q
|
|---|
| 7 | . W !!,"No data found for report specifications."
|
|---|
| 8 | D FIELD^DID(509850,3,"","POINTER","X") K ACKCAT
|
|---|
| 9 | F I=1:1:($L(X("POINTER"),";")-1) S Y=$P(X("POINTER"),";",I),ACKCAT($P(Y,":"))=$P(Y,":",2)
|
|---|
| 10 | S (HD,X1)=0
|
|---|
| 11 | F S HD=$O(ACKCAT(HD)) Q:'HD!($D(DIRUT)) D
|
|---|
| 12 | .S NEWHD=1
|
|---|
| 13 | .F S X1=$O(^TMP("ACKQCDD",$J,"ACKCAT",HD,X1)) Q:'X1!($D(DIRUT)) D
|
|---|
| 14 | ..I $D(^TMP("ACKQCDD",$J,"ACKH",X1)),($P(^(X1),U)>0) D
|
|---|
| 15 | ...I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR W !
|
|---|
| 16 | ...I NEWHD W !!?5,ACKCAT(HD)
|
|---|
| 17 | ...W !?5,$P(^TMP("ACKQCDD",$J,"ACKCAT",HD,X1),U),?15,$P(^(X1),U,2)
|
|---|
| 18 | ...W ?65,$J(^TMP("ACKQCDD",$J,"ACKH",X1),6,2)
|
|---|
| 19 | ...S NEWHD=0
|
|---|
| 20 | W:'$D(DIRUT) !!?55,"Total:",?65,$J(ACKTP,6,2),"%"
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | HDR W @IOF
|
|---|
| 24 | HDR1 S ACKPG=ACKPG+1
|
|---|
| 25 | W "Printed: ",ACKPDT,?(IOM-8),"Page: ",ACKPG,!
|
|---|
| 26 | W ! D CNTR^ACKQUTL("Audiology & Speech Pathology")
|
|---|
| 27 | W ! D CNTR^ACKQUTL("Cost Distribution Report")
|
|---|
| 28 | W ! D CNTR^ACKQUTL("for "_ACKXRNG)
|
|---|
| 29 | W ! D CNTR^ACKQUTL("for DIVISION: "_$$DIVNAME(ACKDIV))
|
|---|
| 30 | S X="",$P(X,"-",IOM)="-" W !,X
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | DIVNAME(ACKDIV) ; get division name
|
|---|
| 34 | Q $$GET1^DIQ(40.8,ACKDIV_",",.01)
|
|---|
