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