Annotation of freem_fileman/DDGFFM.m, revision 1.1.1.1

1.1       snw         1: DDGFFM ;SFISC/MKO-FORM ADD, EDIT, SELECT ;11:48 AM  20 Dec 1994
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
                      4:        ;
                      5: SEL    ;Select another form
                      6: ADD    ;Add a new form
                      7:        N X,DIR0 K DDGFABT
                      8:        S DDGFDY=+$G(DY),DDGFDX=+$G(DX),(DY,DX)=0 X IOXY
                      9:        W $P(DDGLCLR,DDGLDEL,2)
                     10:        X DDGLZOSF("EON"),DDGLZOSF("TRMOFF")
                     11:        ;
                     12:        ;Select file
                     13: FIL    S DDS1="EDIT/CREATE FORM FOR" D W^DICRW K DDS1 G:Y<0 ADDQ
                     14:        G:'$D(@(DIC_"0)")) ADDQ
                     15:        ;
                     16:        ;Select form
                     17:        W !
                     18:        S DIC("S")="I $P(^(0),U,8)=+DDGFFILE"
                     19:        I DUZ(0)'="@" S DIC("S")=DIC("S")_" N DDSI F DDSI=1:1:$L($P(^(0),U,3)) I DUZ(0)[$E($P(^(0),U,3),DDSI) Q"
                     20:        S DDGFFILE=Y,DIC=.403,DIC(0)="QEAL",D="F"_+Y
                     21:        D IX^DIC K DIC,D G:Y<0 ADDQ
                     22:        S DDGFY=Y
                     23:        ;
                     24:        ;Save data for previous form
                     25:        I DDGFCHG,$D(DDGFFM)#2 G:+DDGFFM=+DDGFY ADDQ D  G:$G(DDGFABT) ADDQ
                     26:        . N DDGFFNAM
                     27:        . S DIR(0)="Y",DDGFFNAM=$P(DDGFFM,U,2)
                     28:        . S DIR("A")="Save changes to form "_DDGFFNAM
                     29:        . S DIR("B")="YES"
                     30:        . S DIR("?",1)="  Enter 'Y' or press 'Return' to save changes."
                     31:        . S DIR("?",2)="  Enter 'N' to discard changes."
                     32:        . S DIR("?")="  Enter '^' to return to form "_DDGFFNAM
                     33:        . W ! D ^DIR K DIR I $D(DIRUT) K DIRUT,DUOUT,DTOUT S DDGFABT=1 Q
                     34:        . D SAVE^DDGFSV
                     35:        ;
                     36:        I $D(DDGFFM)#2,+DDGFFM'=+DDGFY D RECOMP^DDGF0
                     37:        ;
                     38:        S DDGFFM=$P(DDGFY,U,1,2)
                     39:        ;
                     40:        ;Stuff in values for form
                     41:        K DR S DIE=.403,DA=+DDGFY,DDGFNEW=$P(DDGFY,U,3)
                     42:        S:DDGFNEW DR="3////"_DUZ_";4///NOW"
                     43:        S DR=$S($G(DR)]"":DR_";",1:"")_"5///NOW"
                     44:        S:DDGFNEW DR=DR_";7////"_+DDGFFILE
                     45:        D ^DIE K DIE,DA,DR,D,%DT
                     46:        I DDGFNEW,$G(DUZ(0))]"" D
                     47:        . S $P(^DIST(.403,+DDGFFM,0),U,2,3)=DUZ(0)_U_DUZ(0)
                     48:        ;
                     49:        ;If this is a new form, create Page 1
                     50:        I DDGFNEW D
                     51:        . K DD,DO
                     52:        . S DIC="^DIST(.403,+DDGFFM,40,",DIC("P")=$P(^DD(.403,40,0),U,2)
                     53:        . S DIC(0)="",DA(1)=+DDGFFM,X=1
                     54:        . D FILE^DICN I Y=-1 K DIC,Y Q
                     55:        . S DIE=DIC,DA=+Y,DR="2////1,1;7////Page 1"
                     56:        . D ^DIE K DIC,DIE,DA,DR,D,Y
                     57:        ;
                     58:        ;Clear data for previous form
                     59:        W $P(DDGLCLR,DDGLDEL,2)
                     60:        I $D(@DDGFREF) K @DDGFREF D DESTALL^DDGLIBW
                     61:        ;
                     62:        ;Get first page, load form
                     63:        S DDGFPG=$O(^DIST(.403,+DDGFFM,40,"B",""))
                     64:        I DDGFPG]"" S DDGFPG=$O(^DIST(.403,+DDGFFM,40,"B",DDGFPG,""))
                     65:        D PG^DDGFLOAD(+DDGFFM,DDGFPG),STATUS^DDGF
                     66:        S DDGFDY=$P(DDGFLIM,U),DDGFDX=$P(DDGFLIM,U,2)
                     67:        ;
                     68: ADDQQ  X DDGLZOSF("EOFF"),DDGLZOSF("TRMON")
                     69:        D RC(DDGFDY,DDGFDX)
                     70:        K DDGFABT,DDGFDY,DDGFDX,DDGFNEW,DDGFY
                     71:        Q
                     72:        ;
                     73: ADDQ   I $D(DDGFFM)#2 D REFRESH^DDGF G ADDQQ
                     74:        K DDGFABT,DDGFDY,DDGFDX
                     75:        Q
                     76:        ;
                     77: EDIT   ;Invoke form to edit form
                     78:        S DDGFDY=DY,DDGFDX=DX
                     79:        K DDSFILE S DDSFILE=.403
                     80:        S DA=+DDGFFM,DR="[DDGF FORM EDIT]",DDSPARM="KTW"
                     81:        D ^DDS K DDSFILE,DR,DDSPARM
                     82:        ;
                     83:        S $P(DDGFFM,U,2)=$P(^DIST(.403,+DDGFFM,0),U)
                     84:        D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
                     85: EDITQ  K DDGFDY,DDGFDX
                     86:        Q
                     87:        ;
                     88: RC(DDGFY,DDGFX)        ;Update status line, reset DX and DY, move cursor
                     89:        N DDGFS
                     90:        I DDGFR D
                     91:        . S DY=IOSL-6,DX=IOM-9,DDGFS="R"_(DDGFY+1)_",C"_(DDGFX+1)
                     92:        . X IOXY W DDGFS_$J("",7-$L(DDGFS))
                     93:        S DY=DDGFY,DX=DDGFX X IOXY
                     94:        Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>