| 1 | DIO2 ;SFISC/GFT,TKW-PRINT ;9:17 AM 24 Feb 2000
|
|---|
| 2 | ;;22.0;VA FileMan;**32**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | S (DISTP,DILCT)=0
|
|---|
| 5 | XDY I $D(DIBTPGM) D @("EN"_DIBTPGM),ENRLS^DIOZ(+$P(DIBTPGM,"^DISZ",2)) Q
|
|---|
| 6 | X DY(DN) G XDY:DN
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | SEARCH S DISEARCH=1 ; Protect switch SO-2/24/2000
|
|---|
| 10 | SCR S DIO("SCR")=1,DE=0 I '$D(DIS(0)) G OR
|
|---|
| 11 | X DIS(0) Q:'$T G PASS:'$D(DIS(1))
|
|---|
| 12 | OR S DE=DE+1 I '$D(DIS(DE)) Q
|
|---|
| 13 | X DIS(DE) E G OR
|
|---|
| 14 | PASS S:'$D(DPQ) DIPASS=1
|
|---|
| 15 | O F DLP=0:1:DX Q:'DN X $S($D(DPQ):DX(DLP),1:^UTILITY($J,99,DLP))
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | N W !
|
|---|
| 19 | T I $X,IOT'="MT" W !
|
|---|
| 20 | I '$D(DIOT(2)),DN,$D(IOSL),$S('$D(DIWF):1,$P(DIWF,"B",2):$P(DIWF,"B",2),1:1)+$Y'<IOSL,$D(^UTILITY($J,1))#2,^(1)?1U1P1E.E X ^(1)
|
|---|
| 21 | S DISTP=DISTP+1,DILCT=DILCT+1 D:'(DISTP#100) CSTP
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | CSTP I $G(IOT)="SPL"!($G(IOT)="HFS") I '$D(DPQ),$$ROUEXIST^DILIBF("XUPARAM"),DILCT>$$KSP^XUPARAM("SPOOL LINES") D Q
|
|---|
| 25 | . S DIFMSTOP=1,DN=0 S:$D(ZTQUEUED) ZTSTOP=1
|
|---|
| 26 | . W !,"*** JOB STOPPED BECAUSE MAXIMUM SPOOL LINES HAS BEEN EXCEEDED ***",!! Q
|
|---|
| 27 | I '$D(ZTQUEUED) K DISTOP Q
|
|---|
| 28 | Q:$G(DISTOP)=0 S:$G(DISTOP)="" DISTOP=1
|
|---|
| 29 | I DISTOP'=1 X DISTOP K:'$T DISTOP S DISTOP=$T Q:'$T
|
|---|
| 30 | Q:'$$S^%ZTLOAD
|
|---|
| 31 | W:$G(IO)]"" !,"*** TASK "_ZTSK_" STOPPED BY USER - DURING "_$S($D(DPQ):"SORT",1:"PRINT")_" EXECUTION ***",!! S ZTSTOP=1,DN=0 Q
|
|---|
| 32 | ;
|
|---|
| 33 | DT I $G(DDXPDATE) D DT^DDXP4 W DDXPY K DDXPY Q
|
|---|
| 34 | I $G(DUZ("LANG"))>1,Y W $$OUT^DIALOGU(Y,"DD") Q
|
|---|
| 35 | I Y W $P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,$E(Y,4,5))_" " W:Y#100 $J(Y#100\1,2)_"," W Y\10000+1700 W:Y#1 " "_$E(Y_0,9,10)_":"_$E(Y_"000",11,12) Q
|
|---|
| 36 | W Y Q
|
|---|
| 37 | ;
|
|---|
| 38 | C S DQ(C)=Y
|
|---|
| 39 | S S Q(C)=Y*Y+Q(C) S:L(C)>Y L(C)=Y S:H(C)<Y H(C)=Y
|
|---|
| 40 | P S N(C)=N(C)+1
|
|---|
| 41 | A S S(C)=S(C)+Y Q
|
|---|
| 42 | D I Y=DITTO(C) S Y="" Q
|
|---|
| 43 | S DITTO(C)=Y Q
|
|---|
| 44 | ;
|
|---|
| 45 | CP S C="" F S C=$O(CP(C)) Q:C="" G DQ:'$D(DQ(C))
|
|---|
| 46 | S CP=CP+1 F S C=$O(CP(C)),A="" Q:C="" F S A=$O(CP(A)) S CP(C,A)=DQ(C)*DQ(A)+CP(C,A) Q:A=C
|
|---|
| 47 | DQ K DQ Q
|
|---|
| 48 | ;
|
|---|
| 49 | H F DI=DI:1:DN I $D(^UTILITY($J,"H",DI)) X ^UTILITY($J,"H",DI) W:$X&($G(DIAR)'=4)&($G(DIAR)'=6) !
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | M X $S($D(DPQ):DX(DIXX),1:^UTILITY($J,99,DIXX))
|
|---|
