Return to DIO2.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIO2.m, revision 1.1

1.1     ! snw         1: DIO2   ;SFISC/GFT,TKW-PRINT ;9/20/94  14:11
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             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 DIO=1
        !            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))