Return to DIL2.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIL2.m, revision 1.1

1.1     ! snw         1: DIL2   ;SFISC/GFT,XAK,TKW-PROCESS HDRS AND TRAILERS ;9/2/94  14:09
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        D T:$D(^UTILITY($J,"T")) S:DIPT $P(^DIPT(DIPT,0),U,7)=DT S:$D(DIBT) $P(^DIBT(DIBT,0),U,7)=DT S:$G(DISV) $P(^DIBT(DISV,0),U,7)=DT
        !             5:        F X=0:0 S X=$O(R(X)) Q:X=""  I X<500,$O(^UTILITY($J,99,X))>499 S DX=X
        !             6:        S X=$S($D(DNP):"",$D(DIWR):" D ^DIWW",($G(DIAR)=4!($G(DIAR)=6)):" W "".""",1:" D T")_$S(DIWL:" K DIWF",1:"")_$S($D(CP):" D CP",1:"")_$P(" S DJ=DJ+1",U,$D(DIS)>9&(L!($D(DISTEMP))))_$S($D(DHIT):" X DHIT",1:"")
        !             7:        I X'["D T" S X=X_" S DISTP=DISTP+1 D:'(DISTP#100) CSTP^DIO2"
        !             8:        S:$D(DISV) X=X_" S ^DIBT("_DISV_",1,D0)="""""
        !             9:        S:X]"" DX=DX+1,^UTILITY($J,99,DX)=$E(X,2,999)
        !            10:        K DIOT S DW=2,(DQI,DV)=DHD,M=M(DP(0)),DL=DV?1"-".E
        !            11:        I 'DV G HT:DV?.P1"[".E1"]",0:DV?1"W ".E,0:$G(DIFIXPT)=1,0:$G(IOST)?1"C".E S ^UTILITY($J,99,0)="Q" G G
        !            12:        I $D(DIPZ) S ^UTILITY($J,1)=^UTILITY($J,1)_" X ^UTILITY($J,2) D HEAD"_^DIPT(DIPZ,"ROU")_^("LAST") G 0
        !            13:        S X="",$P(X,"-",$S(IOM<244:IOM,1:244))="-"
        !            14:        D O S ^UTILITY($J,DV)="W !,"""_X_""",!!",^(1)=^(1)_O
        !            15: 0      S ^UTILITY($J,99,0)="I DC["","""_$S(DIPT=.01:"!($Y>"_(DIOSL-5)_")",1:"")_" X ^UTILITY($J,1)"
        !            16: G      S DX(0)=^UTILITY($J,99,0) K ^UTILITY($J,0),DXIX
        !            17:        I $D(DPP(0)) S DJ=DPP(0,"IX"),DPQ=$O(DPP(DPP(0)))]"",DJK=0 G ^DIO
        !            18:        S DPQ=$P(DPP(1),U,4)["-"!($D(DPP(1,"CM"))&('$D(DPP(1,"PTRIX"))))
        !            19:        F R=2:1:DPP S:'$D(DPP(R,U)) DPQ=1
        !            20:        S:$P(DPP(1),U,5)[";L" DPQ=1
        !            21:        S DJK=1 I DPQ S %=0 F R=1:1:DPP I +$G(DPP(R,"SER"))>% S %=+DPP(R,"SER"),DJK=R
        !            22:        I $D(DPP(DJK,"IX")) S DJ=DPP(DJK,"IX") G ^DIO
        !            23:        S DJ=DK_DK_U_1 I $O(DPP(DJK,-1))>0!$P(DPP(DJK),U,2) S DPQ=1
        !            24:        S:'DPQ DPP(1,"IX")=""
        !            25:        G ^DIO
        !            26:        ;
        !            27: O      S O=" F DE="_DW_":1:"_DHD_" X ^UTILITY($J,DE)" Q
        !            28:        ;
        !            29: T      ;
        !            30:        F DG=-1:0 S DG=$O(^UTILITY($J,"T",DG)) Q:DG=""  S Z="""",I=$P(^(DG),U,6,99) I I]"" F W=2:1 Q:$P(I,Z,W,99)=""  S V=$P(I,Z,W) I V]"",$D(DCL(V)) S I=$P(I,Z,1,W-1)_+DCL(V)_$P(I,Z,W+1,99),W=W-1,^(DG)=$P(^(DG),U,1,5)_U_I
        !            31:        Q
        !            32:        ;
        !            33: HT     S DLP=DX,DCC=M,DV=DW,DNP(1)=DISMIN D INIT^DIP5 S DISMIN=DNP(1) K DNP(1)
        !            34:        F %=0:0 S %=$O(^DIPT("B",$P($P(DHD,"[",2),"]",1),%)) G TT:%="" I $D(^DIPT(%,0)),$P(^(0),U,4)=""!($P(^(0),U,4)=DP) S $P(^(0),U,7)=DT Q
        !            35:        I $D(^("ROU")),^("ROU")[U,'$D(^("DXS")),$D(^("IOM")),^("IOM")'>IOM S ^UTILITY($J,DV)="D "_^("ROU"),DV=DV+1 G EHT
        !            36:        F V=0:0 S V=$O(^DIPT(%,"DXS",V)) Q:V'>0  F I=0:0 S I=$O(^DIPT(%,"DXS",V,I)) Q:I'>0  S R=^(I) D X S ^UTILITY($J,V,I)=R
        !            37:        S DX=-1,DHD="^DIPT("_%_",""F"",DHT)" F DHT=0:0 S DHT=$O(@DHD) S:DHT="" DHT=-1 Q:DHT'>0  S R=^(DHT) D X D  D UNSTACK^DIL:DM
        !            38:        . N DNP D ^DIL
        !            39:        I $L(Y)>1 D PX^DIL
        !            40: EHT    S DX=DLP,DHD=DV-1,M=M(DP(0)) D O,OS^DII:'$D(DISYS) S DW=DV I $P(^DD("OS",DISYS,0),U,6) S O=" N X"_O
        !            41:        I DL S M=M+1,DILIOSL=IOSL-M,^(1)="X DIOT "_^UTILITY($J,1)_" K DIOT(2)",DIOT="I DC?.N,$Y X DIOT(1)"_O,DIOT(1)="S DIOT(2)=1 F %=0:0 W ! Q:$Y>"_DILIOSL,M=M+DCC G 0
        !            42:        S M=DCC,^(1)=^UTILITY($J,1)_O
        !            43: TT     S DHD=$P(DQI,"]",2) G 0:DHD="" S DL=1 G HT
        !            44:        ;
        !            45: X      S W=$F(R,"X DXS("),Y=+$E(R,W,999),X=+$E(R,$F(R,C,W),999) I W,X,Y S R=$E(R,1,W-5)_"^UTILITY($J,"_Y_C_X_$E(R,W+$L(X)+$L(Y)+1,999) G X