Return to DDGFFLDA.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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