source: WorldVistAEHR/trunk/r/QUASAR-ACKQ/ACKQCDD3.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1ACKQCDD3 ;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.
4PRINT ;
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 ;
23HDR W @IOF
24HDR1 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 ;
33DIVNAME(ACKDIV) ; get division name
34 Q $$GET1^DIQ(40.8,ACKDIV_",",.01)
Note: See TracBrowser for help on using the repository browser.