source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENY2REP7.m@ 1739

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

initial load of WorldVistAEHR

File size: 4.1 KB
Line 
1ENY2REP7 ;;(WIRMFO)/DH-Print Y2K Sum by CSN ;8.7.98
2 ;;7.0;ENGINEERING;**51,55**;August 17, 1993
3 ;
4 ; extension of ^ENY2REP1
5 ;
6CSN ; summary by category stock number
7 ; csn initialization
8 S CSN(0)=0 F S CSN(0)=$O(^ENG(6914,"J",CSN(0))) Q:'CSN(0) S ^TMP($J,STATION("PARNT"),"COUNT",CSN(0))=0 F J=0,"NA","FC","NC","CC" S ^TMP($J,STATION("PARNT"),CSN(0),J)=0
9 ; end csn initialization
10 ; begin data gather
11 S CSN(0)=0,STATION=STATION("PARNT") F S CSN(0)=$O(^ENG(6914,"J",CSN(0))) Q:'CSN(0) K:'$D(^ENCSN(6917,CSN(0),0)) ^ENG(6914,"J",CSN(0)) I $D(^ENCSN(6917,CSN(0),0)) S (DA,COUNT)=0 F S DA=$O(^ENG(6914,"J",CSN(0),DA)) Q:'DA D
12 . Q:'$D(^ENG(6914,DA,0))
13 . I "^4^5^"[(U_$P($G(^ENG(6914,DA,3)),U)_U) Q
14 . I '$D(ZTQUEUED),'(DA#100) W "." ; activity indicator
15 . S Y2K=$P($G(^ENG(6914,DA,11)),U) S:Y2K="" Y2K=0
16 . I ENSUP,"^NA^FC^"[(U_Y2K_U) Q
17 . ; initialize station if need be
18 . I ENSTN S STATION=$S($P($G(^ENG(6914,DA,9)),U,5)]"":$P(^(9),U,5),1:STATION("PARNT")) D:'$D(^TMP($J,STATION))
19 .. S TOTAL(STATION)=0 F J=0,"FC","NC","CC","NA" S TOTAL(STATION,J)=0
20 .. S CSN(1)=0 F S CSN(1)=$O(^ENG(6914,"J",CSN(1))) Q:'CSN(1) S ^TMP($J,STATION,"COUNT",CSN(1))=0 F J=0,"FC","NC","CC","NA" S ^TMP($J,STATION,CSN(1),J)=0
21 .. ; end initialization
22 . S ^TMP($J,STATION,"COUNT",CSN(0))=^TMP($J,STATION,"COUNT",CSN(0))+1,^TMP($J,STATION,CSN(0),Y2K)=^TMP($J,STATION,CSN(0),Y2K)+1
23 . S TOTAL(STATION,Y2K)=TOTAL(STATION,Y2K)+1,TOTAL(STATION)=TOTAL(STATION)+1
24 . ; end data gather
25 ; begin sort
26 S STATION=0 F S STATION=$O(^TMP($J,STATION)) Q:STATION="" S CSN(0)=0 F S CSN(0)=$O(^TMP($J,STATION,"COUNT",CSN(0))) Q:'CSN(0) S COUNT=^TMP($J,STATION,"COUNT",CSN(0)) I COUNT D
27 . I $E(ENSORT)="C" D Q
28 .. I $G(ENSORT("MIN"))>COUNT Q
29 .. S ^TMP($J,STATION,"SORT",COUNT,CSN(0))=""
30 . S CSN=$P($G(^ENCSN(6917,CSN(0),0)),U) S:CSN="" CSN=0 S ^TMP($J,STATION,"SORT",CSN,CSN(0))=""
31 . ; end sort
32 ; print the list
33 U IO
34 S STATION=0 F S STATION=$O(^TMP($J,STATION)) Q:STATION=""!($G(ESCAPE)) D Q:$G(ESCAPE) D HOLD Q:$G(ESCAPE)
35 . D HEADR
36 . I '$D(^TMP($J,STATION,"SORT")) W !!,"** No records to print **" Q
37 . I $E(ENSORT)="C" S J=99999 F S J=$O(^TMP($J,STATION,"SORT",J),-1) Q:'J!($G(ESCAPE)) S CSN(0)=0 F S CSN(0)=$O(^TMP($J,STATION,"SORT",J,CSN(0))) Q:'CSN(0) D PRTCSN Q:$G(ESCAPE) ; J => count
38 . I $E(ENSORT)="A" S J="" F S J=$O(^TMP($J,STATION,"SORT",J)) Q:J=""!($G(ESCAPE)) S CSN(0)=0 F S CSN(0)=$O(^TMP($J,STATION,"SORT",J,CSN(0))) Q:'CSN(0) D PRTCSN Q:$G(ESCAPE) ; J => category stock number
39 . D TOTALS
40 K ENTYPE,ENSUP,ENSORT,ENSTN
41 G EXIT
42 ;
43PRTCSN I ENSUP W !,$P(^ENCSN(6917,CSN(0),0),U)_" "_$E($P(^(0),U,3),1,30),?42,$J(^TMP($J,STATION,CSN(0),"NC"),5),?49,$J(^("CC"),5),?63,$J(^(0),5),?71,$J(^TMP($J,STATION,"COUNT",CSN(0)),5)
44 I 'ENSUP W !,$P(^ENCSN(6917,CSN(0),0),U)_" "_$E($P(^(0),U,3),1,25),?35,$J(^TMP($J,STATION,CSN(0),"FC"),5),?42,$J(^("NC"),5),?49,$J(^("CC"),5),?56,$J(^("NA"),5),?63,$J(^(0),5),?71,$J(^TMP($J,STATION,"COUNT",CSN(0)),5)
45 S LINE=LINE+1 I (IOSL-LINE)'>4 D HOLD Q:$G(ESCAPE) I $O(^TMP($J,STATION,"SORT",J,CSN(0)))!($O(^TMP($J,STATION,"SORT",J))]"")!($O(^TMP($J,STATION))]"") D HEADR
46 Q
47 ;
48TOTALS ;
49 Q:$G(ESCAPE)!($G(ENSORT("MIN"))>1) ; skip totals if printing high counts only
50 K X S $P(X,"-",79)="-" W !,X
51 I ENSUP W !,"TOTALS",?42,$J(TOTAL(STATION,"NC"),5),?49,$J(TOTAL(STATION,"CC"),5),?63,$J(TOTAL(STATION,0),5),?71,$J(TOTAL(STATION),5)
52 I 'ENSUP W !,"TOTALS",?35,$J(TOTAL(STATION,"FC"),5),?42,$J(TOTAL(STATION,"NC"),5),?49,$J(TOTAL(STATION,"CC"),5),?56,$J(TOTAL(STATION,"NA"),5),?63,$J(TOTAL(STATION,0),5),?71,$J(TOTAL(STATION),5)
53 Q
54 ;
55HEADR ; header for summary listing
56 W:PAGE>0!($E(IOST,1,2)="C-") @IOF S PAGE=PAGE+1,LINE=4
57 W "Y2K Data by CATEGORY STOCK NUMBER",?45,DATE("PRNT"),?70,"Page: "_PAGE
58 W !,$S('ENSTN:"Consolidated ("_STATION("PARNT")_") ",1:"Station: "_STATION_" ")
59 I ENSUP W "(Y2K CATEGORIES 'FC' and 'NA' are being ignored.)"
60 W !,"CATEGORY STOCK NUMBER",?38,"FC",?45,"NC",?52,"CC",?59,"NA",?64,"NULL",?71,"TOTAL"
61 K X S $P(X,"-",79)="-" W !,X
62 Q
63 ;
64HOLD Q:$E(IOST,1,2)'="C-"
65 W !!,"Press <RETURN> to continue, '^' to escape..." R X:DTIME
66 I '$T!($E(X)="^") S ESCAPE=1
67 Q
68EXIT ;
69 Q
70 ;ENY2REP7
Note: See TracBrowser for help on using the repository browser.