Return to DIPZ2.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIPZ2.m, revision 1.1

1.1     ! snw         1: DIPZ2  ;SFISC/GFT,XAK-COMPILE PRINT TEMPLATES ;9/20/94  14:21
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        F R=0:0 S R=$O(DXS(R)),W="" Q:'R  K:$D(DXS(R))>9 ^DIPT(DIPZ,"DXS",R) F R=R:0 S W=$O(DXS(R,W)) Q:W=""  S ^DIPT(DIPZ,"DXS",R,W)=DXS(R,W)
        !             5:        S DIPZLR=DRN,DRN="",DIL=0 D NEW I $D(^DIPT(DIPZ,"DXS")) S X=" I $D(DXS)<9 F X=0:0 S X=$O(^DIPT("_DIPZ_",""DXS"",X)) Q:'X  S Y=$O(^(X,"""")) F X=X:0 Q:Y=""""  S DXS(X,Y)=^(Y),Y=$O(^(Y))" D L
        !             6: DIL    S DIL=$O(^UTILITY("DIPZ",$J,DIL)) G DHD:'DIL
        !             7:        S DHT=^(DIL) I DRN<DIPZLR,DIL>DRN(+DRN) D SAVE G:DIPZQ K
        !             8:        S X=DHT D L G DIL
        !             9:        ;
        !            10: DHD    F F=2.9:0 S F=$O(^UTILITY($J,F)) Q:'F  S DIL=$L(^(F))+DIL
        !            11:        I DIL+DIPZL>DMAX D SAVE G:DIPZQ K
        !            12:        S X=" Q" D L S X="HEAD ;" D L F F=2.9:0 S F=$O(^UTILITY($J,F)) Q:'F  S X=" "_^(F) D L
        !            13:        S X=" W !,""" F %=1:1 S X=X_"-" I %=IOM!(%>239) S X=X_""",!!" D L Q
        !            14: END    D SAVE G:DIPZQ K
        !            15:        S ^DIPT(DIPZ,"ROUOLD")=DNM,^("IOM")=IOM,^("ROU")=U_DNM,^("LAST")=$S(DRN>1:DRN-1,1:""),DM=0,F=""
        !            16:        K ^("STATS"),DXS F DIP="L","H","DITTO","CP","Q","N","S" I $D(@DIP)>9 S %X=DIP_"(",%Y="^DIPT(DIPZ,""STATS"",DIP," D %XY^%RCR
        !            17:        F DIP=-1:0 S DIP=$O(^DIPT(DIPZ,"F",DIP)) Q:DIP=""  S R=^(DIP) W:'$G(DIPZS) "." D R
        !            18: K      K ^UTILITY($J),^("DIPZ",$J),DIPZL,DISMIN,%X,%Y,DG,DIL,DLN,DL,DM,DMAX,DNM,DRD,DRJ,DIO,DX,DY,DRN,DIPZLR,V,R,W,Y,T,DIDXS,DINC
        !            19:        Q
        !            20:        ;
        !            21: R      Q:R=""  S W=$P(R,$C(126),1),R=$P(R,$C(126),2,999)
        !            22: DM     I DM G UP:$P(W,F,1)]"" S W=$P(W,F,2,999)
        !            23:        I 'W S:W?1"0".E ^DIPT("AF",DP,.001,DIPZ)="" G R
        !            24:        I $P(W,";",1)=+W S ^DIPT("AF",DP,+W,DIPZ)="" G R
        !            25:        G R:W'?.NP1",".E I W<0 S X=-W G DOWN
        !            26:        G R:'$D(^DD(DP,+W,0)) S X=+$P(^(0),U,2) G R:'X
        !            27: DOWN   S DM=DM+1,DP(DM)=DP,DP=X,F=F_+W_C G DM
        !            28: UP     S DP=DP(DM),DM=DM-1,F=$P(F,C,1,DM)_$E(C,DM>0) G DM
        !            29:        ;
        !            30: SAVE   ;
        !            31:        S L=1.001,DINC=.001 S X=" G BEGIN" D L,OS^DII:'$D(DISYS) F %=$S($D(DCL)>9:1,0'[DCL:7,1:10):1 S X=$E($T(TEXT+%),4,999) Q:X=""  D L
        !            32:        I $L(DNM_DRN)>8 S DIPZQ=1 W:'$G(DIPZS) $C(7),!,DNM_DRN_$$EZBLD^DIALOG(1503) S:$G(DIPZRLA)]"" DIPZRLAF=0 Q
        !            33:        S X=DNM_DRN X ^DD("OS",DISYS,"ZS") S %(1)=X D BLD^DIALOG(8025,.%,"","DIR") W:'$G(DIPZS) !,DIR K %,DIR S:$G(DIPZRLA)]"" @DIPZRLA@(DNM_DRN)="",DIPZRLAF=1
        !            34:        S DRN=DRN+1
        !            35: NEW    K ^UTILITY($J,0) S X=DNM_DRN_" ; GENERATED FROM '"_$P(^DIPT(DIPZ,0),U,1)_"' PRINT TEMPLATE (#"_DIPZ_") ; "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
        !            36:        S X=X_" ; ("_$S(DRN="":"FILE "_DP_", MARGIN="_IOM_")",1:"continued)"),L=1,DINC=1,^UTILITY($J,0,L)=X
        !            37:        S X=" S:'$D(DN) DN=1 S DISTP=$G(DISTP),DILCT=$G(DILCT)"
        !            38: L      S L=L+DINC,^UTILITY($J,0,L)=X Q
        !            39:        ;
        !            40:        ;DIALOG #1503  'routine name is too long.  Compilation...aborted'
        !            41:        ;       #8025  '...routine filed.'
        !            42:        ;
        !            43: TEXT   ;
        !            44:        ;;CP G CP^DIO2
        !            45:        ;;C S DQ(C)=Y
        !            46:        ;;S S Q(C)=Y*Y+Q(C) S:L(C)>Y L(C)=Y S:H(C)<Y H(C)=Y
        !            47:        ;;P S N(C)=N(C)+1
        !            48:        ;;A S S(C)=S(C)+Y
        !            49:        ;; Q
        !            50:        ;;D I Y=DITTO(C) S Y="" Q
        !            51:        ;; S DITTO(C)=Y
        !            52:        ;; Q
        !            53:        ;;N W !
        !            54:        ;;T W:$X ! 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)
        !            55:        ;; S DISTP=DISTP+1,DILCT=DILCT+1 D:'(DISTP#100) CSTP^DIO2
        !            56:        ;; Q
        !            57:        ;;DT I $G(DUZ("LANG"))>1,Y W $$OUT^DIALOGU(Y,"DD") Q
        !            58:        ;; 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
        !            59:        ;; W Y Q
        !            60:        ;;M D @DIXX
        !            61:        ;; Q
        !            62:        ;;BEGIN ;