Return to DIPZ.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIPZ.m, revision 1.1

1.1     ! snw         1: DIPZ   ;SFISC/XAK,TKW-COMPILE PRINT TEMPLATES ;01:44 PM  25 Aug 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        I $G(DUZ(0))'="@" W $C(7),$$EZBLD^DIALOG(101) Q
        !             5: EN1    N DNM,X,Y,Z D K I '$D(DISYS) N DISYS D OS^DII
        !             6:        I '$D(^DD("OS",DISYS,"ZS")) W $C(7),$$EZBLD^DIALOG(820) Q
        !             7:        S DTIME=$S('$D(DTIME):300,1:DTIME)
        !             8:        D SIZ^DIPZ0(8034) G:$D(DTOUT)!$D(DUOUT)!'X K S DMAX=X
        !             9: TEM    K DIC S DIC="^DIPT(",DIC(0)="AIEQ"
        !            10:        S DIC("W")="W ?40,""FILE #"",$P(^(0),U,4) W:$D(^(""ROU"")) ?60,^(""ROU"")"
        !            11:        S DIC("S")="I $D(^(""F""))>9,'$P(^(0),U,8),Y'<1" D ^DIC G K:Y<0
        !            12:        S DIPZ=+Y
        !            13:        D RNM^DIPZ0(8034) G:$D(DTOUT)!($D(DUOUT))!(X="") K S DNM=X K DIC
        !            14: IOM    K DIR S DIR("B")=$G(^DIPT(DIPZ,"IOM")) K:'DIR("B") DIR
        !            15:        S DIR(0)="N^19:255",DIR("A")=$$EZBLD^DIALOG(8022) D BLD^DIALOG(8023,"","","DIR(""?"")")
        !            16:        D ^DIR K DIR G:$D(DTOUT)!($D(DUOUT))!'X K S IOM=X
        !            17:        W ! S DIR(0)="Y",DIR("A")=$$EZBLD^DIALOG(8020) D ^DIR K DIR G K:'Y!($D(DIRUT))
        !            18:        S X=DNM,Y=DIPZ D ENZ
        !            19: K      K DMAX,DIC,DCL,R,M,DE,DI,DPP,DIPZ,DHD,DIWL,DIWR,DK,DP,DNP,DCL,DITTO,DUOUT,DIRUT,DIROUT,DTOUT
        !            20:        K %,%H,I,O,C,D,DD,DHT,DIL0,DIP,DN,DU,F,H,L,N,S,Q,CP,DINC Q
        !            21:        ;
        !            22: EN     ;
        !            23:        Q:'$D(^DIPT(Y,"IOM"))!($P($G(^DIPT(Y,0)),U,8))  S IOM=^("IOM") D ENZ G K
        !            24:        ;
        !            25: ENZ    S (R,DCL,DPP)=0 F %=0:0 S R=$O(^DIPT(+Y,"DCL",R)) Q:R=""  F %=1:1 Q:%>$L(^(R))  S Z=$E(^(R),%) I Z?1P S DCL(R)=$G(DCL(R))_Z
        !            26: ENDIP  ;
        !            27:        W:'$G(DIPZS) ! K ^UTILITY($J),^("DIL",$J),^UTILITY("DIPZ",$J),DIPZ,DNP,DIPZLR,DRN,DIPZL,DX,DXS,R N DIPZQ S DIPZQ=0
        !            28:        S DNM=X,DIPZ=+Y,DRD=0,DP=$P(^DIPT(DIPZ,0),U,4),DHD=$S(^("H")="@":"@",1:3) S:$D(^("DNP")) DNP=1
        !            29:        S DK=^DIC(DP,0,"GL"),DMAX=DMAX-$S($D(DCL)>9:800,1:650),DRN=0,R="",L=0,DINC=1
        !            30:        I '$D(IOM) Q:$D(^DIPT(DIPZ,"IOM"))[0  S IOM=^("IOM")
        !            31: AF     D DT^DICRW,INIT^DIP5 S X=-1
        !            32:        S T(1)=$P(^DIPT(DIPZ,0),U),T(2)=$$EZBLD^DIALOG(8034),T(3)=DP D BLD^DIALOG(8024,.T,"","DIR")
        !            33:        W:'$G(DIPZS) !,DIR K DIR
        !            34:        F T=0:0 S X=$O(^DIPT("AF",X)) Q:X=""  F %=0:0 S %=$O(^DIPT("AF",X,%)) Q:'%  K:$D(^(%,DIPZ)) ^(DIPZ)
        !            35:        F C=1:1 Q:'$D(^DIPT(DIPZ,"DXS",C,9.2))&'$D(^(9))  D DXS S:DIDXS DXS(C)=""
        !            36:        S DL=1,DIPZL=0,DHT=-1,C=",",Q="""",^UTILITY($J,1)=""
        !            37:        F DIP=-1:0 S DIP=$O(^DIPT(DIPZ,"F",DIP)) Q:DIP=""  S R=^(DIP) D ^DIL
        !            38:        D UNSTACK^DIL:DM,A^DIL,T^DIL2 K ^DIPT(DIPZ,"T") F R=-1:0 S R=$O(^UTILITY($J,"T",R)) Q:R=""  S ^DIPT(DIPZ,"T",R)=^(R)
        !            39:        S DX=DX+999,Y=$P(" D ^DIWW",1,''$D(DIWR))_" K Y" I DIWL S Y=Y_" K DIWF" S:DIWL=1 ^UTILITY("DIPZ",$J,.5)=" S DIWF=""W"""
        !            40:        D PX^DIPZ1 G ^DIPZ2
        !            41: DXS    S DIDXS=1
        !            42:        I $D(^DIPT(DIPZ,"DXS",C,9)) S X=^(9) D ^DIM I '$D(X) S DIDXS=0
        !            43:        Q
        !            44:        ;
        !            45: EN2(Y,DIPZFLGS,X,DMAX,DIPZRLA,DIPZZMSG)        ;Silent or Talking with parameter passing
        !            46:        ;and optionally return list of routines built and if successful
        !            47:        ;IEN,FLAGS,ROUTINE,RTNMAXSIZE,RTNLISTARRAY,MSGARRAY
        !            48:        ;Y=TEMPLATE IEN (required)
        !            49:        ;FLAGS="T"alk (optional)
        !            50:        ;X=ROUTINE NAME (required)
        !            51:        ;DMAX=ROUTINE SIZE (optional)
        !            52:        ;DIPZRLA=ROUTINE LIST ARRAY, by value (optional)
        !            53:        ;DIPZZMSG=MESSAGE ARRAY (optional) (default ^TMP)
        !            54:        ;*
        !            55:        ;DIPZS will be used to indicate "silent" if set to 1
        !            56:        ;Write statements are made conditional, if not "silent"
        !            57:        ;*
        !            58:        N DIPZS,DNM,DIQUIET,DIPZRIEN,DIPZRLAZ,Z,DIPZRLAF
        !            59:        N DIK,DIC,%I,DICS
        !            60:        S DIPZS=$G(DIPZFLGS)'["T"
        !            61:        S:DIPZS DIQUIET=1
        !            62:        I '$D(DIFM) N DIFM S DIFM=1 D
        !            63:        .N Y,DIPZFLGS,X,DMAX,DIPZRLA,DIPZS
        !            64:        .D INIZE^DIEFU
        !            65:        I $G(Y)'>0 D BLD^DIALOG(1700,"IEN for Print Template missing or invalid") G EN2E
        !            66:        I '$D(^DIPT(Y,0)) D BLD^DIALOG(1700,"No Print Template on file with IEN="_Y) G EN2E
        !            67:        I $G(^DIPT(Y,"IOM"))'>0 D BLD^DIALOG(1700,"No Margin Width for Print Template, IEN="_Y) G EN2E
        !            68:        I $P($G(^DIPT(Y,0)),"^",8) D BLD^DIALOG(1700,"Print Template Invalid, IEN="_Y) G EN2E
        !            69:        I $G(X)']"" D BLD^DIALOG(1700,"Routine name missing this Print Template, IEN="_Y) G EN2E
        !            70:        I X'?1U.NU&(X'?1"%"1U.NU) D BLD^DIALOG(1700,"Routine name invalid") G EN2E
        !            71:        I $L(X)>7 D BLD^DIALOG(1700,"Routine name too long") G EN2E
        !            72:        S DIPZRLA=$G(DIPZRLA,"DIPZRLAZ"),DIPZRIEN=Y
        !            73:        S:DIPZRLA="" DIPZRLA="DIPZRLAZ" S:$G(DMAX)'>0!($G(DMAX)>^DD("ROU")) DMAX=^DD("ROU")
        !            74:        S DIPZRLAF=""
        !            75:        K @DIPZRLA
        !            76:        D EN
        !            77:        G:'DIPZS!(DIPZRLAF) EN2E
        !            78:        D BLD^DIALOG(1700,"Compiling Print Template (IEN="_DIPZRIEN_")"_$S(DIPZRLAF=0:", routine name too long",1:""))
        !            79: EN2E   I 'DIPZS D MSG^DIALOG() Q
        !            80:        I $G(DIPZZMSG)]"" D CALLOUT^DIEFU(DIPZZMSG)
        !            81:        Q
        !            82:        ;
        !            83:        ;DIALOG #101    'only those with programmer's access'
        !            84:        ;       #820    'no way to save routines on the system'
        !            85:        ;       #8020   'Should the compilation run now?'
        !            86:        ;       #8022   'Margin Width for output.'
        !            87:        ;       #8023   'Type a number from 19 to 255.  This is the number...'
        !            88:        ;       #8024   'Compiling template name Print template of file n'
        !            89:        ;       #8034   'Print template'