Return to DDGFFLDA.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDGFFLDA.m, revision 1.1

1.1     ! snw         1: DDGFFLDA       ;SFISC/MKO-ADD A FIELD ;01:43 PM  22 Nov 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: ADD    ;Add a field
        !             5:        I '$O(^DIST(.403,+DDGFFM,40,DDGFPG,40,0)) D  Q
        !             6:        . D MSG^DDGF($C(7)_"There are no blocks defined on this page.  To add a block, press <PF2>B.")
        !             7:        . H 2 D MSG^DDGF()
        !             8:        S DDGFDY=DY,DDGFDX=DX
        !             9:        ;
        !            10:        ;Invoke form to select block, field order, field type
        !            11:        K DDGFBLCK,DDGFFORD,DDGFTYPE
        !            12:        S DDSFILE=.404,DDSFILE(1)=.4044
        !            13:        S DR="[DDGF FIELD ADD]",DDSPARM="KTW"
        !            14:        D ^DDS K DDSFILE,DA,DR,DDSPARM
        !            15:        ;
        !            16:        I '$D(DDGFBLCK)!'$D(DDGFFORD)!'$D(DDGFTYPE) G ADDQ
        !            17:        ;
        !            18:        ;Get relative field coordinates
        !            19:        S (DDGFCAP,DDGFCAP0)=""
        !            20:        S (DDGFSUP,DDGFSUP0)=""
        !            21:        S (DDGFCC,DDGFCC0)=""
        !            22:        ;
        !            23:        S DDGFB2=@DDGFREF@("F",DDGFPG,DDGFBLCK)
        !            24:        S DDGFB1=$P(DDGFB2,U),DDGFB2=$P(DDGFB2,U,2)
        !            25:        ;
        !            26:        I DDGFTYPE=1 D
        !            27:        . S DDGFCC0=DDGFDY-DDGFB1+1_","_(DDGFDX-DDGFB2+1)
        !            28:        E  D
        !            29:        . S DDGFD1=DDGFDY-DDGFB1+1,DDGFD2=DDGFDX-DDGFB2+1
        !            30:        . S (DDGFDC,DDGFDC0)=DDGFD1_","_DDGFD2
        !            31:        . S (DDGFDL,DDGFDL0)=1
        !            32:        ;
        !            33:        I DDGFTYPE'=1,DDGFD1<1!(DDGFD2<1) D  G ADDQ
        !            34:        . D MSG^DDGF($C(7)_"Unable to add a field above or to the left of the block.")
        !            35:        . H 2 D MSG^DDGF()
        !            36:        ;
        !            37:        K DDGFD1,DDGFD2
        !            38:        ;
        !            39:        ;Add field order to block file
        !            40:        S DIC="^DIST(.404,"_DDGFBLCK_",40,",DIC(0)="L"
        !            41:        S DIC("P")=$P(^DD(.404,40,0),U,2)
        !            42:        S DA(1)=DDGFBLCK,X=DDGFFORD
        !            43:        D FILE^DICN
        !            44:        I Y=-1 K DIC,DA,Y D MSG^DDGF($C(7)_"Unable to add field.") H 2 D MSG^DDGF() G ADDQ
        !            45:        ;
        !            46:        ;Stuff values for field type, data coordinate, and data length
        !            47:        S DIE=DIC,DA(1)=DDGFBLCK,DA=+Y
        !            48:        S DR="2////"_DDGFTYPE
        !            49:        S:DDGFTYPE'=1 DR=DR_";4.1////"_DDGFDC_";4.2////1"
        !            50:        D ^DIE K DIC,DIE,DR,Y
        !            51:        ;
        !            52:        ;Invoke appropriate form
        !            53:        S DDSFILE=.404,DDSFILE(1)=.4044,DDSPARM="CKTW"
        !            54:        S DDGFDD=$P(^DIST(.404,DDGFBLCK,0),U,2)
        !            55:        S DR="[DDGF FIELD "_$P("CAPTION ONLY^FORM ONLY^DD^COMPUTED",U,DDGFTYPE)_"]"
        !            56:        D ^DDS K DDSFILE,DR,DDSPARM,DDGFDD
        !            57:        ;
        !            58:        I $D(DA)#2,DDGFTYPE'=1,$G(DDSCHANG)'=1 D
        !            59:        . S DIK="^DIST(.404,"_DA(1)_",40,"
        !            60:        . D ^DIK K DIK
        !            61:        E  I $D(DA)#2 D
        !            62:        . D SAVE
        !            63:        . D LOADF
        !            64:        ;
        !            65: ADDQ   ;Refresh and cleanup
        !            66:        D REFRESH^DDGF
        !            67:        D RC(DDGFDY,DDGFDX)
        !            68:        ;
        !            69:        K DA,DDSCHANG
        !            70:        K DDGFB1,DDGFB2,DDGFD1,DDGFD2
        !            71:        K DDGFSUP,DDGFSUP0,DDGFCAP,DDGFCAP0,DDGFCC,DDGFCC0
        !            72:        K DDGFDL,DDGFDL0,DDGFDC,DDGFDC0
        !            73:        K DDGFDY,DDGFDX,DDGFBLCK,DDGFFORD,DDGFTYPE
        !            74:        Q
        !            75:        ;
        !            76: SAVE   ;Save changes to caption, coordinates, data length, and suppress
        !            77:        ;colon flag
        !            78:        S:DDGFCAP="" (DDGFSUP,DDGFCC)=""
        !            79:        S DR=""
        !            80:        ;
        !            81:        S:DDGFCAP]"" DR=DR_"1////"_DDGFCAP_";"
        !            82:        S:DDGFCC]"" DR=DR_"5.1////"_DDGFCC_";"
        !            83:        S:DDGFSUP DR=DR_"5.2////1;"
        !            84:        ;
        !            85:        I DDGFTYPE'=1 D
        !            86:        . S:DDGFDC'=DDGFDC0 DR=DR_"4.1////"_DDGFDC_";"
        !            87:        . S:DDGFDL'=DDGFDL0 DR=DR_"4.2////"_DDGFDL_";"
        !            88:        I DR="" K DR Q
        !            89:        ;
        !            90:        S DIE="^DIST(.404,"_DA(1)_",40,"
        !            91:        S DR=$E(DR,1,$L(DR)-1)
        !            92:        D ^DIE K DIE,DR,Y
        !            93:        Q
        !            94:        ;
        !            95: LOADF  ;Set DDGFREF and window buffer
        !            96:        N C,C1,C2,C3,D,D1,D2,D3,L
        !            97:        ;
        !            98:        I DDGFCAP="" D
        !            99:        . S (C,C1,C2,C3)=""
        !           100:        . K @DDGFREF@("F",DDGFPG,DDGFBLCK,DA)
        !           101:        E  D
        !           102:        . S C=DDGFCAP_$S(DDGFTYPE'=1&'DDGFSUP:":",1:"")
        !           103:        . S C1=$P(DDGFCC,",")-1+DDGFB1
        !           104:        . S C2=$P(DDGFCC,",",2)-1+DDGFB2
        !           105:        . S C3=C2+$L(C)-1
        !           106:        . ;
        !           107:        . S @DDGFREF@("F",DDGFPG,DDGFBLCK,DA)=C1_U_C2_U_C3_U_C
        !           108:        . S @DDGFREF@("RC",DDGFWID,C1,C2,C3,DDGFBLCK,DA,"C")=""
        !           109:        . D WRITE^DDGLIBW(DDGFWID,C,C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"",1)
        !           110:        ;
        !           111:        I DDGFTYPE'=1 D
        !           112:        . S D1=$P(DDGFDC,",")-1+DDGFB1
        !           113:        . S D2=$P(DDGFDC,",",2)-1+DDGFB2
        !           114:        . S D3=D2+DDGFDL-1
        !           115:        . ;
        !           116:        . S $P(@DDGFREF@("F",DDGFPG,DDGFBLCK,DA),U,5,8)=D1_U_D2_U_D3_U_DDGFDL
        !           117:        . I D1]"",D2]"" S @DDGFREF@("RC",DDGFWID,D1,D2,D3,DDGFBLCK,DA,"D")=""
        !           118:        . D:DDGFDL WRITE^DDGLIBW(DDGFWID,$TR($J("",DDGFDL)," ","_"),D1-$P(DDGFLIM,U),D2-$P(DDGFLIM,U,2),"",1)
        !           119:        Q
        !           120:        ;
        !           121: RC(DDGFY,DDGFX)        ;Update status line, reset DX and DY, move cursor
        !           122:        N S
        !           123:        I DDGFR D
        !           124:        . S DY=IOSL-6,DX=IOM-9,S="R"_(DDGFY+1)_",C"_(DDGFX+1)
        !           125:        . X IOXY W S_$J("",7-$L(S))
        !           126:        S DY=DDGFY,DX=DDGFX X IOXY
        !           127:        Q