Return to DDS0.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDS0.m, revision 1.1.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