Return to DDGFHBK.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDGFHBK.m, revision 1.1

1.1     ! snw         1: DDGFHBK        ;SFISC/MKO-ADD, EDIT, DELETE HEADER BLOCK ;01:48 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 header block
        !             6:        ;Check to see if a header block already exists for this page
        !             7:        S DDGFBH=$P(^DIST(.403,+DDGFFM,40,DDGFPG,0),U,2)
        !             8:        I DDGFBH D MSG^DDGF($C(7)_"This page already has a header block.") H 2 D MSG^DDGF() K DDGFBH Q
        !             9:        ;
        !            10:        N B
        !            11:        S DDGFDY=DY,DDGFDX=DX
        !            12:        ;
        !            13:        ;Invoke form to enter block name
        !            14:        K DDGFBNUM,DDGFBNAM
        !            15:        D DDS(.404,"[DDGF HEADER BLOCK SELECT]")
        !            16:        G:$G(DDGFBNUM)=DDGFBH!'$G(DDGFBNUM) ADDQ
        !            17:        ;
        !            18:        I $D(^DIST(.403,+DDGFFM,40,DDGFPG,40,"B",DDGFBNUM)) D DDS(.404,"[DDGF BLOCK ADD]","",21) G ADDQ
        !            19:        ;
        !            20:        S $P(^DIST(.403,+DDGFFM,40,DDGFPG,0),U,2)=DDGFBNUM
        !            21:        ;
        !            22:        ;If this looks like a brand new block, stuff in DD number
        !            23:        I $L(^DIST(.404,DDGFBNUM,0),U)=1,'$O(^(0)) D
        !            24:        . S DIE="^DIST(.404,",DA=DDGFBNUM
        !            25:        . S DR="1////"_$P(^DIST(.403,+DDGFFM,0),U,8)
        !            26:        . D ^DIE K DIE,DA,DR
        !            27:        ;
        !            28:        D:DDGFBH DELETE^DDGFBK(DDGFBH,1)
        !            29:        D BK^DDGFLOAD(DDGFPG,DDGFBNUM,$P(DDGFLIM,U),$P(DDGFLIM,U,2),0,0,1,1)
        !            30:        ;
        !            31:        S DY=DDGFDY,DX=DDGFDX
        !            32:        S B=DDGFBNUM,C=$P(@DDGFREF@("F",DDGFPG,B),U,4)
        !            33:        S DDGFADD=1
        !            34:        K DDGFBNUM,DDGFBNAM
        !            35:        G EDIT
        !            36:        ;
        !            37: ADDQ   ;Abort adding a header block
        !            38:        D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
        !            39:        K DDGFANS,DDGFBH,DDGFBNUM,DDGFBNAM,DDGFDY,DDGFDX
        !            40:        Q
        !            41:        ;
        !            42: EDIT   ;Edit/Delete header block
        !            43:        ;In: B,C
        !            44:        N C1,C2,C3
        !            45:        S DDGFDY=DY,DDGFDX=DX,DDGFBH=B
        !            46:        S (DDGFBKNN,DDGFBKNO)=C
        !            47:        S DDSFILE=.403,DDSFILE(1)=.4031,DA(1)=+DDGFFM,DA=DDGFPG
        !            48:        S DR="[DDGF HEADER BLOCK EDIT]",DDSPARM="KTW"
        !            49:        D ^DDS K DDSFILE,DA,DR,DDSPARM
        !            50:        S DDGFBHN=$P(^DIST(.403,+DDGFFM,40,DDGFPG,0),U,2)
        !            51:        ;
        !            52:        I DDGFBHN'=DDGFBH D
        !            53:        . D DELETE^DDGFBK(DDGFBH,DDGFBHN)
        !            54:        . D:DDGFBHN BK^DDGFLOAD(DDGFPG,DDGFBHN,$P(DDGFLIM,U),$P(DDGFLIM,U,2),0,0,1,1)
        !            55:        ;
        !            56:        S C=DDGFBKNN,B=DDGFBHN
        !            57:        ;
        !            58:        ;Update TMP if coordinates or name changed, or new block
        !            59:        I DDGFBKNN'=DDGFBKNO!$G(DDGFADD) D
        !            60:        . D WRITE^DDGLIBW(DDGFWIDB,$J("",$L(DDGFBKNO)),$P(DDGFLIM,U),$P(DDGFLIM,U,2),"",1)
        !            61:        . D WRITE^DDGLIBW(DDGFWIDB,C,$P(DDGFLIM,U),$P(DDGFLIM,U,2),"",1)
        !            62:        ;
        !            63:        D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
        !            64:        S:'$G(DDGFADD) DDGFE=1
        !            65:        K DDGFADD,DDGFBH,DDGFBHN,DDGFBKNN,DDGFBKNO,DDGFDY,DDGFDX
        !            66:        Q
        !            67:        ;
        !            68: DDS(DDSFILE,DR,DA,DDSPAGE)     ;
        !            69:        ;Call DDS
        !            70:        S DDSPARM="KTW" D ^DDS K DDSPARM
        !            71:        Q
        !            72:        ;
        !            73: RC(DDGFY,DDGFX)        ;Update status line, reset DX and DY, move cursor
        !            74:        N S
        !            75:        I DDGFR D
        !            76:        . S DY=IOSL-6,DX=IOM-9,S="R"_(DDGFY+1)_",C"_(DDGFX+1)
        !            77:        . X IOXY W S_$J("",7-$L(S))
        !            78:        S DY=DDGFY,DX=DDGFX X IOXY
        !            79:        Q