- DDGFFM ;SFISC/MKO-FORM ADD, EDIT, SELECT ;11:48 AM 20 Dec 1994
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- SEL ;Select another form
- ADD ;Add a new form
- N X,DIR0 K DDGFABT
- S DDGFDY=+$G(DY),DDGFDX=+$G(DX),(DY,DX)=0 X IOXY
- W $P(DDGLCLR,DDGLDEL,2)
- X DDGLZOSF("EON"),DDGLZOSF("TRMOFF")
- ;
- ;Select file
- FIL S DDS1="EDIT/CREATE FORM FOR" D W^DICRW K DDS1 G:Y<0 ADDQ
- G:'$D(@(DIC_"0)")) ADDQ
- ;
- ;Select form
- W !
- S DIC("S")="I $P(^(0),U,8)=+DDGFFILE"
- 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"
- S DDGFFILE=Y,DIC=.403,DIC(0)="QEAL",D="F"_+Y
- D IX^DIC K DIC,D G:Y<0 ADDQ
- S DDGFY=Y
- ;
- ;Save data for previous form
- I DDGFCHG,$D(DDGFFM)#2 G:+DDGFFM=+DDGFY ADDQ D G:$G(DDGFABT) ADDQ
- . N DDGFFNAM
- . S DIR(0)="Y",DDGFFNAM=$P(DDGFFM,U,2)
- . S DIR("A")="Save changes to form "_DDGFFNAM
- . S DIR("B")="YES"
- . S DIR("?",1)=" Enter 'Y' or press 'Return' to save changes."
- . S DIR("?",2)=" Enter 'N' to discard changes."
- . S DIR("?")=" Enter '^' to return to form "_DDGFFNAM
- . W ! D ^DIR K DIR I $D(DIRUT) K DIRUT,DUOUT,DTOUT S DDGFABT=1 Q
- . D SAVE^DDGFSV
- ;
- I $D(DDGFFM)#2,+DDGFFM'=+DDGFY D RECOMP^DDGF0
- ;
- S DDGFFM=$P(DDGFY,U,1,2)
- ;
- ;Stuff in values for form
- K DR S DIE=.403,DA=+DDGFY,DDGFNEW=$P(DDGFY,U,3)
- S:DDGFNEW DR="3////"_DUZ_";4///NOW"
- S DR=$S($G(DR)]"":DR_";",1:"")_"5///NOW"
- S:DDGFNEW DR=DR_";7////"_+DDGFFILE
- D ^DIE K DIE,DA,DR,D,%DT
- I DDGFNEW,$G(DUZ(0))]"" D
- . S $P(^DIST(.403,+DDGFFM,0),U,2,3)=DUZ(0)_U_DUZ(0)
- ;
- ;If this is a new form, create Page 1
- I DDGFNEW D
- . K DD,DO
- . S DIC="^DIST(.403,+DDGFFM,40,",DIC("P")=$P(^DD(.403,40,0),U,2)
- . S DIC(0)="",DA(1)=+DDGFFM,X=1
- . D FILE^DICN I Y=-1 K DIC,Y Q
- . S DIE=DIC,DA=+Y,DR="2////1,1;7////Page 1"
- . D ^DIE K DIC,DIE,DA,DR,D,Y
- ;
- ;Clear data for previous form
- W $P(DDGLCLR,DDGLDEL,2)
- I $D(@DDGFREF) K @DDGFREF D DESTALL^DDGLIBW
- ;
- ;Get first page, load form
- S DDGFPG=$O(^DIST(.403,+DDGFFM,40,"B",""))
- I DDGFPG]"" S DDGFPG=$O(^DIST(.403,+DDGFFM,40,"B",DDGFPG,""))
- D PG^DDGFLOAD(+DDGFFM,DDGFPG),STATUS^DDGF
- S DDGFDY=$P(DDGFLIM,U),DDGFDX=$P(DDGFLIM,U,2)
- ;
- ADDQQ X DDGLZOSF("EOFF"),DDGLZOSF("TRMON")
- D RC(DDGFDY,DDGFDX)
- K DDGFABT,DDGFDY,DDGFDX,DDGFNEW,DDGFY
- Q
- ;
- ADDQ I $D(DDGFFM)#2 D REFRESH^DDGF G ADDQQ
- K DDGFABT,DDGFDY,DDGFDX
- Q
- ;
- EDIT ;Invoke form to edit form
- S DDGFDY=DY,DDGFDX=DX
- K DDSFILE S DDSFILE=.403
- S DA=+DDGFFM,DR="[DDGF FORM EDIT]",DDSPARM="KTW"
- D ^DDS K DDSFILE,DR,DDSPARM
- ;
- S $P(DDGFFM,U,2)=$P(^DIST(.403,+DDGFFM,0),U)
- D REFRESH^DDGF,RC(DDGFDY,DDGFDX)
- EDITQ K DDGFDY,DDGFDX
- Q
- ;
- RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
- N DDGFS
- I DDGFR D
- . S DY=IOSL-6,DX=IOM-9,DDGFS="R"_(DDGFY+1)_",C"_(DDGFX+1)
- . X IOXY W DDGFS_$J("",7-$L(DDGFS))
- S DY=DDGFY,DX=DDGFX X IOXY
- Q
- DDGFFM ;SFISC/MKO-FORM ADD, EDIT, SELECT ;11:48 AM 20 Dec 1994
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- SEL ;Select another form
- ADD ;Add a new form
- +1 NEW X,DIR0
- KILL DDGFABT
- +2 SET DDGFDY=+$GET(DY)
- SET DDGFDX=+$GET(DX)
- SET (DY,DX)=0
- XECUTE IOXY
- +3 WRITE $PIECE(DDGLCLR,DDGLDEL,2)
- +4 XECUTE DDGLZOSF("EON")
- XECUTE DDGLZOSF("TRMOFF")
- +5 ;
- +6 ;Select file
- FIL SET DDS1="EDIT/CREATE FORM FOR"
- DO W^DICRW
- KILL DDS1
- IF Y<0
- GOTO ADDQ
- +1 IF '$DATA(@(DIC_"0)"))
- GOTO ADDQ
- +2 ;
- +3 ;Select form
- +4 WRITE !
- +5 SET DIC("S")="I $P(^(0),U,8)=+DDGFFILE"
- +6 IF DUZ(0)'="@"
- SET 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"
- +7 SET DDGFFILE=Y
- SET DIC=.403
- SET DIC(0)="QEAL"
- SET D="F"_+Y
- +8 DO IX^DIC
- KILL DIC,D
- IF Y<0
- GOTO ADDQ
- +9 SET DDGFY=Y
- +10 ;
- +11 ;Save data for previous form
- +12 IF DDGFCHG
- IF $DATA(DDGFFM)#2
- IF +DDGFFM=+DDGFY
- GOTO ADDQ
- Begin DoDot:1
- +13 NEW DDGFFNAM
- +14 SET DIR(0)="Y"
- SET DDGFFNAM=$PIECE(DDGFFM,U,2)
- +15 SET DIR("A")="Save changes to form "_DDGFFNAM
- +16 SET DIR("B")="YES"
- +17 SET DIR("?",1)=" Enter 'Y' or press 'Return' to save changes."
- +18 SET DIR("?",2)=" Enter 'N' to discard changes."
- +19 SET DIR("?")=" Enter '^' to return to form "_DDGFFNAM
- +20 WRITE !
- DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- KILL DIRUT,DUOUT,DTOUT
- SET DDGFABT=1
- QUIT
- +21 DO SAVE^DDGFSV
- End DoDot:1
- IF $GET(DDGFABT)
- GOTO ADDQ
- +22 ;
- +23 IF $DATA(DDGFFM)#2
- IF +DDGFFM'=+DDGFY
- DO RECOMP^DDGF0
- +24 ;
- +25 SET DDGFFM=$PIECE(DDGFY,U,1,2)
- +26 ;
- +27 ;Stuff in values for form
- +28 KILL DR
- SET DIE=.403
- SET DA=+DDGFY
- SET DDGFNEW=$PIECE(DDGFY,U,3)
- +29 IF DDGFNEW
- SET DR="3////"_DUZ_";4///NOW"
- +30 SET DR=$SELECT($GET(DR)]"":DR_";",1:"")_"5///NOW"
- +31 IF DDGFNEW
- SET DR=DR_";7////"_+DDGFFILE
- +32 DO ^DIE
- KILL DIE,DA,DR,D,%DT
- +33 IF DDGFNEW
- IF $GET(DUZ(0))]""
- Begin DoDot:1
- +34 SET $PIECE(^DIST(.403,+DDGFFM,0),U,2,3)=DUZ(0)_U_DUZ(0)
- End DoDot:1
- +35 ;
- +36 ;If this is a new form, create Page 1
- +37 IF DDGFNEW
- Begin DoDot:1
- +38 KILL DD,DO
- +39 SET DIC="^DIST(.403,+DDGFFM,40,"
- SET DIC("P")=$PIECE(^DD(.403,40,0),U,2)
- +40 SET DIC(0)=""
- SET DA(1)=+DDGFFM
- SET X=1
- +41 DO FILE^DICN
- IF Y=-1
- KILL DIC,Y
- QUIT
- +42 SET DIE=DIC
- SET DA=+Y
- SET DR="2////1,1;7////Page 1"
- +43 DO ^DIE
- KILL DIC,DIE,DA,DR,D,Y
- End DoDot:1
- +44 ;
- +45 ;Clear data for previous form
- +46 WRITE $PIECE(DDGLCLR,DDGLDEL,2)
- +47 IF $DATA(@DDGFREF)
- KILL @DDGFREF
- DO DESTALL^DDGLIBW
- +48 ;
- +49 ;Get first page, load form
- +50 SET DDGFPG=$ORDER(^DIST(.403,+DDGFFM,40,"B",""))
- +51 IF DDGFPG]""
- SET DDGFPG=$ORDER(^DIST(.403,+DDGFFM,40,"B",DDGFPG,""))
- +52 DO PG^DDGFLOAD(+DDGFFM,DDGFPG)
- DO STATUS^DDGF
- +53 SET DDGFDY=$PIECE(DDGFLIM,U)
- SET DDGFDX=$PIECE(DDGFLIM,U,2)
- +54 ;
- ADDQQ XECUTE DDGLZOSF("EOFF")
- XECUTE DDGLZOSF("TRMON")
- +1 DO RC(DDGFDY,DDGFDX)
- +2 KILL DDGFABT,DDGFDY,DDGFDX,DDGFNEW,DDGFY
- +3 QUIT
- +4 ;
- ADDQ IF $DATA(DDGFFM)#2
- DO REFRESH^DDGF
- GOTO ADDQQ
- +1 KILL DDGFABT,DDGFDY,DDGFDX
- +2 QUIT
- +3 ;
- EDIT ;Invoke form to edit form
- +1 SET DDGFDY=DY
- SET DDGFDX=DX
- +2 KILL DDSFILE
- SET DDSFILE=.403
- +3 SET DA=+DDGFFM
- SET DR="[DDGF FORM EDIT]"
- SET DDSPARM="KTW"
- +4 DO ^DDS
- KILL DDSFILE,DR,DDSPARM
- +5 ;
- +6 SET $PIECE(DDGFFM,U,2)=$PIECE(^DIST(.403,+DDGFFM,0),U)
- +7 DO REFRESH^DDGF
- DO RC(DDGFDY,DDGFDX)
- EDITQ KILL DDGFDY,DDGFDX
- +1 QUIT
- +2 ;
- RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
- +1 NEW DDGFS
- +2 IF DDGFR
- Begin DoDot:1
- +3 SET DY=IOSL-6
- SET DX=IOM-9
- SET DDGFS="R"_(DDGFY+1)_",C"_(DDGFX+1)
- +4 XECUTE IOXY
- WRITE DDGFS_$JUSTIFY("",7-$LENGTH(DDGFS))
- End DoDot:1
- +5 SET DY=DDGFY
- SET DX=DDGFX
- XECUTE IOXY
- +6 QUIT
