Return to DDS0.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDS0.m, revision 1.1

1.1     ! snw         1: DDS0   ;SFISC/MLH-SETUP, CLEANUP ;09:38 AM  30 Nov 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        ;
        !             5: EN(DDSFILE,DR,DA)      ;Initial setup
        !             6:        S U="^"
        !             7:        D INIT^DDGLIB0() Q:$G(DIERR)
        !             8:        D FORM(.DDSFILE,DR) Q:$G(DIERR)
        !             9:        ;
        !            10:        ;Compile the form if not already compiled
        !            11:        S DDSREFS=$$REF(DDS)
        !            12:        I '$$COMPILED(DDS) D EN^DDSZ(DDS) Q:$G(DIERR)
        !            13:        S:$P(^DIST(.403,+DDS,0),U,10) DA="NOREC"
        !            14:        ;
        !            15:        D FRSTPG(DDS,.DA,$G(DDSPAGE)) Q:$G(DIERR)
        !            16:        D REC(DDP,.DA) Q:$G(DIERR)
        !            17:        D INIT
        !            18:        Q
        !            19:        ;
        !            20: FORM(DDSFILE,DR)       ;Form lookup
        !            21:        ;Output:
        !            22:        ;  DDS     = Form number^Form name
        !            23:        ;  DDP     = File number (or 0)
        !            24:        ;  DDSPG   = First page to go to on form
        !            25:        ;  DIERR
        !            26:        ;
        !            27:        I $D(DDSFILE)[0 D BLD^DIALOG(201,"DDSFILE") Q
        !            28:        ;
        !            29:        N DIC,X,Y
        !            30:        ;
        !            31:        S DDP=$S(DDSFILE=+DDSFILE:DDSFILE,1:+$P($G(@(DDSFILE_"0)")),U,2))
        !            32:        S X=$S(DR:DR,1:$P($P(DR,"[",2),"]"))
        !            33:        S DIC="^DIST(.403,",DIC(0)="FNX",D="F"_DDP
        !            34:        D IX^DIC K DIC
        !            35:        ;
        !            36:        I Y<0 D BLD^DIALOG(3021,X) Q
        !            37:        I '$O(^DIST(.403,+Y,40,"B","")) D BLD^DIALOG(3022,X) Q
        !            38:        S DDS=Y
        !            39:        ;
        !            40:        I $D(DDSFILE(1))#2 S DDP=$S(DDSFILE(1)=+DDSFILE(1):DDSFILE(1),1:+$P($G(@(DDSFILE(1)_"0)")),U,2))
        !            41:        Q
        !            42:        ;
        !            43: FRSTPG(DDS,DA,DDSPAGE) ;Get first page of form
        !            44:        ;Output:
        !            45:        ;  DDSPG
        !            46:        ;  DDSSEL = 1, if DA is null and there is a record selection page
        !            47:        ;  DIERR
        !            48:        ;
        !            49:        N P
        !            50:        I $G(DA)!($G(DA)="NOREC") D
        !            51:        . S P=$S($G(DDSPAGE):DDSPAGE,1:1)
        !            52:        . S DDSPG=$O(^DIST(.403,+DDS,40,"B",P,""))
        !            53:        . I $D(^DIST(.403,+DDS,40,+DDSPG,0))[0 D BLD^DIALOG(3023,"number "_P)
        !            54:        E  D PG^DDSRSEL D:'$G(DDSSEL) BLD^DIALOG(202,"record")
        !            55:        Q
        !            56:        ;
        !            57: REC(DDP,DA)    ;Check record and lock
        !            58:        ;Output:
        !            59:        ;  DIE      = Global root
        !            60:        ;  DDSDA    = DA,DA(1),...,
        !            61:        ;  DDSDAORG = Original DA array
        !            62:        ;  DDSDL    = Level number (top=0)
        !            63:        ;  DDSDLORG = Original level number
        !            64:        ;  DDSFLORG  = Orig DDP^Orig DIE
        !            65:        ;  D0,D1,etc.
        !            66:        ;  DIERR
        !            67:        ;
        !            68:        I '$G(DA) D  Q
        !            69:        . S DIE="",(DDSDL,DDSDLORG)=0,DDSDA="0,"
        !            70:        . S:'$D(DA) DA="" S DDSDAORG=DA
        !            71:        ;
        !            72:        D GL^DDS10(DDP,.DA,.DIE,.DDSDL,.DDSDA,1) Q:$G(DIERR)
        !            73:        ;
        !            74:        I $D(DIOVRD)[0 D  Q:$G(DIERR)
        !            75:        . N DDSTOP S DDSTOP=$$FNO^DILIBF(DDP)
        !            76:        . Q:$P($G(^DD(DDSTOP,0,"DI")),U,2)'["Y"
        !            77:        . N P S P("FILE")=$P(@(DIE_"0)"),U)
        !            78:        . D BLD^DIALOG(405,DDSTOP,.P)
        !            79:        ;
        !            80:        S DDSDLORG=DDSDL
        !            81:        K DDSDAORG S (DDSDAORG,@("D"_DDSDL))=DA
        !            82:        F DDSI=1:1:DDSDL S (DDSDAORG(DDSI),@("D"_(DDSDL-DDSI)))=DA(DDSI)
        !            83:        S DDSFLORG=$G(DDP)_$G(DIE)
        !            84:        K DDSI
        !            85:        Q
        !            86:        ;
        !            87: INIT   ;Initialize some variables
        !            88:        ; DDSHBX   = $Y of first line of help area
        !            89:        ; DDSREFT  = Global reference of temporary global location
        !            90:        ; DDSFDO   = 1 if entire form is display-only
        !            91:        ; DDSCHG   = Change flag
        !            92:        ; DDSKM    = Flag to keep whatever's in help area
        !            93:        ; DDSH     = Flag to indicate help area is empty
        !            94:        ; DDSSC    = Array to indicate what pages are on the screen
        !            95:        ;
        !            96:        S DDSHBX=IOSL-7
        !            97:        S DDXY=IOXY_" S $X=DX,$Y=DY"
        !            98:        ;
        !            99:        K DDH,DDSSC,DDSCHANG,DDSSAVE
        !           100:        S DDSH=1,(DDH,DDM,DDSCHG,DDSSC)=0,DDACT="N"
        !           101:        S DDSREFT="^TMP(""DDS"",$J,"_+DDS_")"
        !           102:        ;
        !           103:        N %,%H,%I,X
        !           104:        D NOW^%DTC
        !           105:        S $P(^DIST(.403,+DDS,0),U,6)=$E(%,1,12)
        !           106:        Q
        !           107:        ;
        !           108: END    I $D(DDSHBX) S DX=0,DY=IOSL-1 X IOXY
        !           109:        D KILL^DDGLIB0($G(DDSPARM))
        !           110:        ;
        !           111:        I $D(^TMP("DDS",$J,"LOCK")) D
        !           112:        . N I
        !           113:        . S I="" F  S I=$O(^TMP("DDS",$J,"LOCK",I)) Q:I=""  L -@I
        !           114:        . K ^TMP("DDS",$J,"LOCK")
        !           115:        ;
        !           116:        K:'$G(DA) DA
        !           117:        I $D(DA),$D(DDSDAORG)#2,$D(DDSDLORG)#2 D
        !           118:        . K DA,D0
        !           119:        . S DA=DDSDAORG
        !           120:        . F DDSI=1:1:DDSDLORG S DA(DDSI)=DDSDAORG(DDSI) K @("D"_DDSI)
        !           121:        ;
        !           122:        K:$G(DDSPARM)'["E" DIERR,^TMP("DIERR",$J)
        !           123:        K:$D(DDSREFT)#2 @DDSREFT,DDSREFT
        !           124:        K ^TMP("DDSH",$J),^TMP("DDSWP",$J)
        !           125:        K DDACT,DDH,DDM,DDO,DDP,DDQ,DDS,DDSDDP
        !           126:        K DDSBK,DDSBR,DDSCHG,DDSDA,DDSDAORG,DDSDL
        !           127:        K DDSDLORG,DDSDN,DDSEXT,DDSFDO,DDSFLD,DDSFLORG,DDSGL,DDSH,DDSI
        !           128:        K DDSKM,DDSLN,DDSNP,DDSO,DDSOLD,DDSORD,DDSOPB,DDSOSV,DDSPTB,DDSPG
        !           129:        K DDSPX,DDSPY,DDSQ,DDSREP,DDSSC,DDSSP,DDSTP,DDSU,DDSX
        !           130:        K DDSHBX,DDSREFS,DDXY
        !           131:        K DIC,DIR,DIR0N,DIROUT,DIRUT,DUOUT,DY,DX
        !           132:        K A1,D,DDC,DDD,DI,DIEQ,DIK,DIW,DIY,DIZ,DS
        !           133:        Q
        !           134:        ;
        !           135: COMPILED(DDS)  ;Return 1 if form is compiled
        !           136:        Q $D(@$$REF(DDS))>0
        !           137:        ;
        !           138: REF(DDS)       ;Return global reference for compiled global
        !           139:        ;Q "^DIST(.403,""AZ"","_+DDS_")"
        !           140:        Q "^DIST(.403,"_+DDS_",""AZ"")"
        !           141:        ;
        !           142: IXF    ;
        !           143:        N D0,DA,DIC,DP,Y S DIC="^DD("_DDGFDD_",",DIC(0)="EMN" D ^DIC
        !           144:        I Y'>0 K X
        !           145:        E  S X=+$P(Y,"E")
        !           146:        Q