Return to DDGFBK.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDGFBK.m, revision 1.1

1.1     ! snw         1: DDGFBK ;SFISC/MKO-ADD, EDIT, DELETE BLOCK ;01:47 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:        ;
        !             5: ADD    ;Add a new block
        !             6:        N B,C1,C2,C3
        !             7:        S DDGFDY=DY,DDGFDX=DX
        !             8:        ;
        !             9:        ;Invoke form to enter block name
        !            10:        K DDGFBNUM,DDGFBNAM
        !            11:        D DDS(.404,"[DDGF BLOCK ADD]")
        !            12:        G:'$D(DDGFBNUM) ADDQ
        !            13:        ;
        !            14:        ;Ask whether block should be added or indicate duplicate block
        !            15:        K DDGFANS
        !            16:        S DDSPAGE=$S($P(^DIST(.403,+DDGFFM,40,DDGFPG,0),U,2)=DDGFBNUM!$D(^(40,"B",DDGFBNUM)):21,1:11)
        !            17:        D DDS(.404,"[DDGF BLOCK ADD]","",DDSPAGE)
        !            18:        G:DDSPAGE=21!'$G(DDGFANS) ADDQ
        !            19:        K DDSPAGE,DDGFANS
        !            20:        ;
        !            21:        ;Add block to page
        !            22:        S DIC="^DIST(.403,+DDGFFM,40,DDGFPG,40,",DIC(0)="L"
        !            23:        S DA(2)=+DDGFFM,DA(1)=DDGFPG
        !            24:        S DIC("P")=$P(^DD(.4031,40,0),U,2)
        !            25:        S (DINUM,X)=DDGFBNUM
        !            26:        D FILE^DICN K DINUM,X
        !            27:        G:Y=-1 ADDQ
        !            28:        ;
        !            29:        ;Stuff in values for block order, coordinates, and type
        !            30:        S DIE=DIC,DA=+Y
        !            31:        S DDGFC=DDGFDY-$P(DDGFLIM,U)+1_","_(DDGFDX-$P(DDGFLIM,U,2)+1)
        !            32:        S DR="1////"_($O(^DIST(.403,+DDGFFM,40,DDGFPG,40,"AC",""),-1)+1\1)_";2////"_DDGFC_";3////e"
        !            33:        D ^DIE K DA,DIC,DIE,DR,X,Y,DDGFC
        !            34:        ;
        !            35:        ;If this looks like a brand new block, stuff in DD number
        !            36:        I $L(^DIST(.404,DDGFBNUM,0),U)=1,'$O(^(0)) D
        !            37:        . S DIE="^DIST(.404,",DA=DDGFBNUM
        !            38:        . S DR="1////"_$P(^DIST(.403,+DDGFFM,0),U,8)
        !            39:        . D ^DIE K DA,DIE,DR
        !            40:        ;
        !            41:        D BK^DDGFLOAD(DDGFPG,DDGFBNUM,$P(DDGFLIM,U),$P(DDGFLIM,U,2),DDGFDY,DDGFDX,0,1)
        !            42:        ;
        !            43:        S DY=DDGFDY,DX=DDGFDX
        !            44:        S B=DDGFBNUM,C=$P(@DDGFREF@("F",DDGFPG,B),U,4)
        !            45:        S C1=DY,C2=DX,C3=C2+$L(DDGFBNAM)-1
        !            46:        S DDGFADD=1
        !            47:        K DDGFBNUM,DDGFBNAM
        !            48:        S:$G(DDGFBV) DDGFORIG(B)=DY_U_DX
        !            49:        G EDIT
        !            50:        ;
        !            51: ADDQ   ;Adding aborted
        !            52:        D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
        !            53:        K DDGFANS,DDGFBNAM,DDGFBNUM,DDGFDX,DDGFDY,DDSPAGE,DA,DIC,Y
        !            54:        Q
        !            55:        ;
        !            56: EDIT   ;Edit block
        !            57:        ;In: B,C1,C2,C3,C
        !            58:        S DDGFDY=DY,DDGFDX=DX
        !            59:        S DDGFBK=B,DDGFC1=C1,DDGFC2=C2,DDGFC3=C3
        !            60:        S DDGFBKCO=C1-$P(DDGFLIM,U)+1_","_(C2-$P(DDGFLIM,U,2)+1)
        !            61:        S DDGFBKNO=C
        !            62:        ;
        !            63:        ;Invoke form to edit block
        !            64:        S DDSFILE=.403,DDSFILE(1)=.4032
        !            65:        S DA(2)=+DDGFFM,DA(1)=DDGFPG,DA=B
        !            66:        S DR="[DDGF BLOCK EDIT]",DDSPARM="KTW"
        !            67:        D ^DDS K DDSFILE,DA,DR,DDSPARM
        !            68:        ;
        !            69:        ;If block was deleted, remove data from DDGFREF
        !            70:        I $D(^DIST(.403,+DDGFFM,40,DDGFPG,40,DDGFBK,0))[0 D DELETE(DDGFBK) G EDITQ
        !            71:        ;
        !            72:        S:$D(DDGFBKCN)[0 DDGFBKCN=DDGFBKCO
        !            73:        S:$D(DDGFBKNN)[0 DDGFBKNN=DDGFBKNO
        !            74:        ;
        !            75:        S C=DDGFBKNN
        !            76:        S C1=$P(DDGFBKCN,",")-1+$P(DDGFLIM,U)
        !            77:        S C2=$P(DDGFBKCN,",",2)-1+$P(DDGFLIM,U,2)
        !            78:        S C3=C2+$L(C)-1
        !            79:        ;
        !            80:        ;Update TMP if coordinates or name changed, or new block
        !            81:        I DDGFBKCN'=DDGFBKCO!(DDGFBKNN'=DDGFBKNO)!$G(DDGFADD) D
        !            82:        . D WRITE^DDGLIBW(DDGFWIDB,$J("",$L(DDGFBKNO)),DDGFC1-$P(DDGFLIM,U),DDGFC2-$P(DDGFLIM,U,2),"",1)
        !            83:        . D WRITE^DDGLIBW(DDGFWIDB,C,C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"",1)
        !            84:        ;
        !            85: EDITQ  D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
        !            86:        S:'$G(DDGFADD) DDGFE=1
        !            87:        K DDGFADD,DDGFBK,DDGFBKCO,DDGFBKNO,DDGFBKCN,DDGFBKNN
        !            88:        K DDGFC1,DDGFC2,DDGFC3,DDGFDX,DDGFDY
        !            89:        Q
        !            90:        ;
        !            91: DELETE(B,E)    ;Remove block from DDGFREF
        !            92:        ;E : means don't set DDGFEBV or DDGFBDEL
        !            93:        ;    (used by EDIT^DDGFHBK when a different header block is chosen)
        !            94:        N F,N
        !            95:        ;Remove from TMP
        !            96:        S F="" F  S F=$O(@DDGFREF@("F",DDGFPG,B,F)) Q:F=""  D
        !            97:        . S N=@DDGFREF@("F",DDGFPG,B,F)
        !            98:        . K:$P(N,U,4)]"" @DDGFREF@("RC",DDGFWID,$P(N,U),$P(N,U,2),$P(N,U,3),B)
        !            99:        . K:$P(N,U,8)>0 @DDGFREF@("RC",DDGFWID,$P(N,U,5),$P(N,U,6),$P(N,U,7),B)
        !           100:        K @DDGFREF@("F",DDGFPG,B)
        !           101:        ;
        !           102:        ;If no blocks on page, set DDGFEBV to exit Block Viewer
        !           103:        ;DDGFBDEL indicates block name should not be painted
        !           104:        I $G(DDGFBV) D:'$G(E)
        !           105:        . I '$P(^DIST(.403,+DDGFFM,40,DDGFPG,0),U,2),'$O(^(40,0)) S DDGFEBV=1
        !           106:        . S DDGFBDEL=1
        !           107:        E  D PG^DDGFLOAD(+DDGFFM,+DDGFPG,1,1)
        !           108:        ;
        !           109:        ;If used on no other forms, ask whether to delete from block file
        !           110:        I '$O(^DIST(.403,"AB",B,"")),'$O(^DIST(.403,"AC",B,"")) D
        !           111:        . K DDGFANS S DDGFBK=B
        !           112:        . D DDS(.404,"[DDGF BLOCK DELETE]")
        !           113:        . I $G(DDGFANS) S DIK="^DIST(.404,",DA=DDGFBK D ^DIK K DIK,DA
        !           114:        . K DDGFANS,DDGFBK
        !           115:        Q
        !           116:        ;
        !           117: DDS(DDSFILE,DR,DA,DDSPAGE)     ;
        !           118:        ;Call DDS
        !           119:        S DDSPARM="KTW" D ^DDS K DDSPARM
        !           120:        Q
        !           121:        ;
        !           122: RC(DDGFY,DDGFX)        ;Update status line, reset DX and DY, move cursor
        !           123:        N S
        !           124:        I DDGFR D
        !           125:        . S DY=IOSL-6,DX=IOM-9,S="R"_(DDGFY+1)_",C"_(DDGFX+1)
        !           126:        . X IOXY W S_$J("",7-$L(S))
        !           127:        S DY=DDGFY,DX=DDGFX X IOXY
        !           128:        Q