Return to DDGFHBK.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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