DDS1 ;SFISC/MKO - LOAD PAGE ;21MAR2017
;;22.2;VA FileMan;**5**;Jan 05, 2016;Build 28
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;;GFT;**115,1003,1004,1028,1053,1057**
;
;Input:
; DDS = Form number^Form name
; DDSPG = Internal page number
; DA = Record array
; DDSREFT = Global location where data (temporarily) is stored
; DDP = Primary file number of form
; DIE = Global root of form
; DDSDA = DA,DA(1),... of form
; DDSDL = Level number
;Also needed for pointed-to blocks:
; DDSDAORG
; DDSDLORG
;Returns:
; DIERR
;
EN(DDSPG,DDSAGAIN) ;entry point moved from 1st line.
;
N DDS1B,DDS1BO K DDSMOUSE S U="^"
;
;Get header block
S DDS1B=$P($G(^DIST(.403,+DDS,40,DDSPG,0)),U,2)
I DDS1B]"" D BLK(DDSPG,DDS1B,"",1) G:$G(DIERR) END
;
;Get all other blocks on page
S DDS1BO="" F S DDS1BO=$O(^DIST(.403,+DDS,40,DDSPG,40,"AC",DDS1BO)) Q:DDS1BO="" S DDS1B=$O(^(DDS1BO,0)) Q:'DDS1B D BLK(DDSPG,DDS1B,DDS1BO) G:$G(DIERR) END
;
END K DDSMOUSE
Q
;
BLK(DDSPG,DDS1B,DDS1BO,DDS1H,DDS1E) ;Load block
;In: DDS1H = 1 if a header block
; DDS1E = 1 if we're loading up a pointed-to block and
; we want interactive dialog (DIC(0)["E") in the lookup
;
I $D(^DIST(.404,DDS1B,0))[0 D BLD^DIALOG(3051,"#"_DDS1B) Q
;
N DDS1PTB,DDS1REP S DDS1PTB=""
I '$G(DDS1H) D
. S DDS1PTB=$G(^DIST(.403,+DDS,40,DDSPG,40,DDS1B,1)),DDS1REP=$G(^(2))
. K:DDS1REP<2 DDS1REP
;
I DDS1PTB]"" N @$$D0(DDSDL),DA,DDP,DIE,DDSDL,DDSDA D Q:$G(DIERR)
. I $G(DDS1REP)>1 D
.. D BK^DDS10(.DDS1B,.DDP) Q:$G(DIERR)
.. D GDA^DDS10(DDS1B,$G(DDS1E),.DA) Q:$G(DIERR)
.. S DDP=$G(^DD(DDP,0,"UP"),DDP) ;GFT
.. D GL^DDS10(DDP,.DA,.DIE,.DDSDL,.DDSDA,1)
.. D GETD0(.DA,DDSDL)
. E D
.. D SET^DDS10(DDS1B,$G(DDS1E),.DA,.DDP,.DIE,.DDSDL,.DDSDA) ;GO GET THE NEW 'DA' VALUE
.. I +$G(DIERR)=1,$G(^TMP("DIERR",$J,1))=601 D Q
... L -@(DIE_DA_")")
... K ^TMP("DDS",$J,"LOCK",DIE_DA_")")
... D CLEAN^DILF
... S (DA,D0,DDSDA)=""
.. Q:$G(DIERR)
.. I DA="",'$G(DDS1E),$P($G(@DDSREFT@(DDSPG,DDS1B)),U)]"" S DDSDA=$P(^(DDS1B),U),DA=+DDSDA
.. S D0=DA
;
I $G(DA)!'$G(DDSDAORG),$G(@DDSREFT@(DDSPG,DDS1B,DDSDA))<1 D
. S $P(@DDSREFT@(DDSPG,DDS1B,DDSDA),U)=1
. I $G(DDS1REP)>1 D REP Q
. ;
. S @DDSREFT@(DDSPG,DDS1B,DDSDA,"GL")=DIE
. D EN^DDS11(DDS1B)
;
I '$G(DDSAGAIN)!'$D(@DDSREFT@(DDSPG,DDS1B)) S $P(@DDSREFT@(DDSPG,DDS1B),U)=$G(DDSDA)
Q
;
REP ;Load data for repeating block
N DDS1DDP,DDS1IND,DDS1INI,DDS1MUL,DDS1PDA,DDS1REF,DDS1RT,DDS1SEL
N DDS1SN,DDS1VAL,DDS1FSCR,DDS1SCNT,DDS1STRT,DDS1Q,DDS1ACT
S DDS1REF=$NA(@DDSREFT@(DDSPG,DDS1B))
S DDS1DDP=$P(@DDSREFS@(DDSPG,DDS1B),U,3)
S DDS1IND=$P(DDS1REP,U,2) S:DDS1IND="" DDS1IND="B"
S DDS1INI=$P(DDS1REP,U,3)
S DDS1SEL=$P(@DDSREFS@(DDSPG,DDS1B),U,10)
S DDS1PDA=DDSDA
;
S DDS1MUL=$O(^DD(+DDP,"SB",DDS1DDP,""))
S:$G(^DD(DDS1DDP,0,"SCR"))]"" DDS1FSCR=^("SCR")
ACT S:$G(^("ACT"))]"" DDS1ACT=^("ACT")
;
S $P(@DDS1REF@(DDS1PDA),U,7,10)=DDP_U_DDS1MUL_U_DDS1SEL_U_DDS1IND
S @DDS1REF@(DDSDA,"GL")=$S(DDS1MUL:DIE_+DA_","""_$P($P(^DD(DDP,DDS1MUL,0),U,4),";")_""",",1:^DIC(DDS1DDP,0,"GL"))
;
N DIE,DDP
S DIE=@DDS1REF@(DDSDA,"GL"),DDS1RT=$$CREF^DILF(DIE),DDP=DDS1DDP
S DDS1SN=0
;
I DDS1MUL D ;IT'S A MULTIPLE FIELD WITHIN TOP-LEVEL FILE
. D DDA^DDS5(0,.DA,.DDSDL)
. S DDSDA=","_DDSDA
. S:'$D(@DDS1RT@(DDS1IND)) DDS1IND="!IEN"
. I DDS1IND="!IEN" D
.. S DA=0 F S DA=$O(@DDS1RT@(DA)) Q:'DA D REPLD
. E D
.. S (DDS1Q,DDS1STRT)=$NA(@DDS1RT@(DDS1IND)),DDS1SCNT=$QL(DDS1Q)
.. F S DDS1Q=$Q(@DDS1Q) Q:DDS1Q="" Q:$NA(@DDS1Q,DDS1SCNT)'=DDS1STRT D
... S DA=$QS(DDS1Q,$QL(DDS1Q)) D REPLD
;
GFT E I $G(^DIST(.403,+DDS,40,DDSPG,40,DDS1B,"COMP MUL"))]"" D S DDSDA=DDS1PDA,DA=+DDSDA,@DDS1REF@("COMP MUL")=$G(^DIST(.403,+DDS,40,DDSPG,40,DDS1B,"COMP MUL PTR")) ;COMPUTED MULTIPLE BUILDS A REPEATING BLOCK
.N DICMX,D
.I $G(^("COMP MUL PTR"))="" S DICMX="S DA=$G(D0,$G(D)) N D D NOFILE^DDS1"
.E S DICMX="S DA=$G(D0,$G(D)) N D D REPLD^DDS1"
.X ^("COMP MUL")
;
E I $G(DA) S DDS1VAL=DA N D0,DA,DDSDA D ;IT'S A RELATIONAL JUMP (DA COULD BE UNDEFINED FOR AN UNRELATED FILE!)
. S DDSDA=","
. S (DDS1Q,DDS1STRT)=$NA(@DDS1RT@(DDS1IND,DDS1VAL)),DDS1SCNT=$QL(DDS1Q)
. F S DDS1Q=$Q(@DDS1Q) Q:DDS1Q="" Q:$NA(@DDS1Q,DDS1SCNT)'=DDS1STRT D
.. S DA=$QS(DDS1Q,$QL(DDS1Q)) D REPLD
;
E S DIERR=1 Q
;Now set INITIAL POSITION
DISV I DDS1INI="u" S DDS1INI="l" I $G(DUZ)]"",$G(DIE)]"" D I DDS1INI
.N T
.S T=$G(^DISV(DUZ,DIE)) Q:'T S T=$G(@DDS1REF@(DDS1PDA,"B",T_",")) Q:'T ;Get entry that SPACE-BAR would return
.S DDS1SN=T,T=T-DDS1REP+1
.I T>0 S DDS1INI=T_U_(DDS1SN-T+1)_U_DDS1SN Q
.S DDS1INI=1_U_DDS1SN_U_DDS1SN
E I DDS1INI="l"!(DDS1INI="n") D
. N N,T
. S N=DDS1INI="n"
F . S DDS1SN=$O(@DDS1REF@(DDS1PDA," "),-1)+N S:'DDS1SN DDS1SN=1 ;Don't want 1^0^0
. S T=DDS1SN-DDS1REP+2-N
. S DDS1INI=$S(T<1:1_U_DDS1SN,1:T_U_(DDS1REP-'N))_U_DDS1SN
E S DDS1INI="1^1^1"
;
S $P(@DDS1REF@(DDS1PDA),U,2,6)=DDS1PDA_U_DDS1INI_U_+DDS1REP
;
I DDS1MUL D
. D UDA^DDS5(.DA,.DDSDL)
. S DDSDA=$P(DDSDA,",",2,999)
Q
;
REPLD ;Load data
Q:'$D(@DDS1RT@(DA,0)) I $D(DDS1FSCR) N Y S Y=DA X DDS1FSCR Q:'$T
I $D(DDS1ACT) D
.N DIC,Y
.S DIC(0)="E",Y=DA_U_$P(@DDS1RT@(DA,0),U)
.X DDS1ACT ;HERE IS WHERE ACCESS AUDITING WOULD TAKE PLACE IF IT IS SET UP IN POST-ACTION!
NOFILE S DDS1SN=DDS1SN+1,$P(DDSDA,",")=DA,@("D"_DDSDL)=DA
S @DDS1REF@(DDS1PDA,DDS1SN)=DDSDA
S @DDS1REF@(DDS1PDA,"B",DDSDA)=DDS1SN
D EN^DDS11(DDS1B)
Q
;
D0(DL) ;Given DL, return string D0,D1,...,Dn
N I,S
S S="" F I=0:1:DL S S=S_"D"_I_","
S:S?.E1"," S=$E(S,1,$L(S)-1)
Q S
;
GETD0(DA,DL) ;Given DA array, set D0,D1...
N I
S @("D"_DL)=DA
F I=1:1:DL-1 S @("D"_(DL-I))=DA(I)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDS1 6017 printed Nov 22, 2024@17:52:56 Page 2
DDS1 ;SFISC/MKO - LOAD PAGE ;21MAR2017
+1 ;;22.2;VA FileMan;**5**;Jan 05, 2016;Build 28
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;;GFT;**115,1003,1004,1028,1053,1057**
+7 ;
+8 ;Input:
+9 ; DDS = Form number^Form name
+10 ; DDSPG = Internal page number
+11 ; DA = Record array
+12 ; DDSREFT = Global location where data (temporarily) is stored
+13 ; DDP = Primary file number of form
+14 ; DIE = Global root of form
+15 ; DDSDA = DA,DA(1),... of form
+16 ; DDSDL = Level number
+17 ;Also needed for pointed-to blocks:
+18 ; DDSDAORG
+19 ; DDSDLORG
+20 ;Returns:
+21 ; DIERR
+22 ;
EN(DDSPG,DDSAGAIN) ;entry point moved from 1st line.
+1 ;
+2 NEW DDS1B,DDS1BO
KILL DDSMOUSE
SET U="^"
+3 ;
+4 ;Get header block
+5 SET DDS1B=$PIECE($GET(^DIST(.403,+DDS,40,DDSPG,0)),U,2)
+6 IF DDS1B]""
DO BLK(DDSPG,DDS1B,"",1)
if $GET(DIERR)
GOTO END
+7 ;
+8 ;Get all other blocks on page
+9 SET DDS1BO=""
FOR
SET DDS1BO=$ORDER(^DIST(.403,+DDS,40,DDSPG,40,"AC",DDS1BO))
if DDS1BO=""
QUIT
SET DDS1B=$ORDER(^(DDS1BO,0))
if 'DDS1B
QUIT
DO BLK(DDSPG,DDS1B,DDS1BO)
if $GET(DIERR)
GOTO END
+10 ;
END KILL DDSMOUSE
+1 QUIT
+2 ;
BLK(DDSPG,DDS1B,DDS1BO,DDS1H,DDS1E) ;Load block
+1 ;In: DDS1H = 1 if a header block
+2 ; DDS1E = 1 if we're loading up a pointed-to block and
+3 ; we want interactive dialog (DIC(0)["E") in the lookup
+4 ;
+5 IF $DATA(^DIST(.404,DDS1B,0))[0
DO BLD^DIALOG(3051,"#"_DDS1B)
QUIT
+6 ;
+7 NEW DDS1PTB,DDS1REP
SET DDS1PTB=""
+8 IF '$GET(DDS1H)
Begin DoDot:1
+9 SET DDS1PTB=$GET(^DIST(.403,+DDS,40,DDSPG,40,DDS1B,1))
SET DDS1REP=$GET(^(2))
+10 if DDS1REP<2
KILL DDS1REP
End DoDot:1
+11 ;
+12 IF DDS1PTB]""
NEW @$$D0(DDSDL),DA,DDP,DIE,DDSDL,DDSDA
Begin DoDot:1
+13 IF $GET(DDS1REP)>1
Begin DoDot:2
+14 DO BK^DDS10(.DDS1B,.DDP)
if $GET(DIERR)
QUIT
+15 DO GDA^DDS10(DDS1B,$GET(DDS1E),.DA)
if $GET(DIERR)
QUIT
+16 ;GFT
SET DDP=$GET(^DD(DDP,0,"UP"),DDP)
+17 DO GL^DDS10(DDP,.DA,.DIE,.DDSDL,.DDSDA,1)
+18 DO GETD0(.DA,DDSDL)
End DoDot:2
+19 IF '$TEST
Begin DoDot:2
+20 ;GO GET THE NEW 'DA' VALUE
DO SET^DDS10(DDS1B,$GET(DDS1E),.DA,.DDP,.DIE,.DDSDL,.DDSDA)
+21 IF +$GET(DIERR)=1
IF $GET(^TMP("DIERR",$JOB,1))=601
Begin DoDot:3
+22 LOCK -@(DIE_DA_")")
+23 KILL ^TMP("DDS",$JOB,"LOCK",DIE_DA_")")
+24 DO CLEAN^DILF
+25 SET (DA,D0,DDSDA)=""
End DoDot:3
QUIT
+26 if $GET(DIERR)
QUIT
+27 IF DA=""
IF '$GET(DDS1E)
IF $PIECE($GET(@DDSREFT@(DDSPG,DDS1B)),U)]""
SET DDSDA=$PIECE(^(DDS1B),U)
SET DA=+DDSDA
+28 SET D0=DA
End DoDot:2
End DoDot:1
if $GET(DIERR)
QUIT
+29 ;
+30 IF $GET(DA)!'$GET(DDSDAORG)
IF $GET(@DDSREFT@(DDSPG,DDS1B,DDSDA))<1
Begin DoDot:1
+31 SET $PIECE(@DDSREFT@(DDSPG,DDS1B,DDSDA),U)=1
+32 IF $GET(DDS1REP)>1
DO REP
QUIT
+33 ;
+34 SET @DDSREFT@(DDSPG,DDS1B,DDSDA,"GL")=DIE
+35 DO EN^DDS11(DDS1B)
End DoDot:1
+36 ;
+37 IF '$GET(DDSAGAIN)!'$DATA(@DDSREFT@(DDSPG,DDS1B))
SET $PIECE(@DDSREFT@(DDSPG,DDS1B),U)=$GET(DDSDA)
+38 QUIT
+39 ;
REP ;Load data for repeating block
+1 NEW DDS1DDP,DDS1IND,DDS1INI,DDS1MUL,DDS1PDA,DDS1REF,DDS1RT,DDS1SEL
+2 NEW DDS1SN,DDS1VAL,DDS1FSCR,DDS1SCNT,DDS1STRT,DDS1Q,DDS1ACT
+3 SET DDS1REF=$NAME(@DDSREFT@(DDSPG,DDS1B))
+4 SET DDS1DDP=$PIECE(@DDSREFS@(DDSPG,DDS1B),U,3)
+5 SET DDS1IND=$PIECE(DDS1REP,U,2)
if DDS1IND=""
SET DDS1IND="B"
+6 SET DDS1INI=$PIECE(DDS1REP,U,3)
+7 SET DDS1SEL=$PIECE(@DDSREFS@(DDSPG,DDS1B),U,10)
+8 SET DDS1PDA=DDSDA
+9 ;
+10 SET DDS1MUL=$ORDER(^DD(+DDP,"SB",DDS1DDP,""))
+11 if $GET(^DD(DDS1DDP,0,"SCR"))]""
SET DDS1FSCR=^("SCR")
ACT if $GET(^("ACT"))]""
SET DDS1ACT=^("ACT")
+1 ;
+2 SET $PIECE(@DDS1REF@(DDS1PDA),U,7,10)=DDP_U_DDS1MUL_U_DDS1SEL_U_DDS1IND
+3 SET @DDS1REF@(DDSDA,"GL")=$SELECT(DDS1MUL:DIE_+DA_","""_$PIECE($PIECE(^DD(DDP,DDS1MUL,0),U,4),";")_""",",1:^DIC(DDS1DDP,0,"GL"))
+4 ;
+5 NEW DIE,DDP
+6 SET DIE=@DDS1REF@(DDSDA,"GL")
SET DDS1RT=$$CREF^DILF(DIE)
SET DDP=DDS1DDP
+7 SET DDS1SN=0
+8 ;
+9 ;IT'S A MULTIPLE FIELD WITHIN TOP-LEVEL FILE
IF DDS1MUL
Begin DoDot:1
+10 DO DDA^DDS5(0,.DA,.DDSDL)
+11 SET DDSDA=","_DDSDA
+12 if '$DATA(@DDS1RT@(DDS1IND))
SET DDS1IND="!IEN"
+13 IF DDS1IND="!IEN"
Begin DoDot:2
+14 SET DA=0
FOR
SET DA=$ORDER(@DDS1RT@(DA))
if 'DA
QUIT
DO REPLD
End DoDot:2
+15 IF '$TEST
Begin DoDot:2
+16 SET (DDS1Q,DDS1STRT)=$NAME(@DDS1RT@(DDS1IND))
SET DDS1SCNT=$QLENGTH(DDS1Q)
+17 FOR
SET DDS1Q=$QUERY(@DDS1Q)
if DDS1Q=""
QUIT
if $NAME(@DDS1Q,DDS1SCNT)'=DDS1STRT
QUIT
Begin DoDot:3
+18 SET DA=$QSUBSCRIPT(DDS1Q,$QLENGTH(DDS1Q))
DO REPLD
End DoDot:3
End DoDot:2
End DoDot:1
+19 ;
GFT ;COMPUTED MULTIPLE BUILDS A REPEATING BLOCK
IF '$TEST
IF $GET(^DIST(.403,+DDS,40,DDSPG,40,DDS1B,"COMP MUL"))]""
Begin DoDot:1
+1 NEW DICMX,D
+2 IF $GET(^("COMP MUL PTR"))=""
SET DICMX="S DA=$G(D0,$G(D)) N D D NOFILE^DDS1"
+3 IF '$TEST
SET DICMX="S DA=$G(D0,$G(D)) N D D REPLD^DDS1"
+4 XECUTE ^("COMP MUL")
End DoDot:1
SET DDSDA=DDS1PDA
SET DA=+DDSDA
SET @DDS1REF@("COMP MUL")=$GET(^DIST(.403,+DDS,40,DDSPG,40,DDS1B,"COMP MUL PTR"))
+5 ;
+6 ;IT'S A RELATIONAL JUMP (DA COULD BE UNDEFINED FOR AN UNRELATED FILE!)
IF '$TEST
IF $GET(DA)
SET DDS1VAL=DA
NEW D0,DA,DDSDA
Begin DoDot:1
+7 SET DDSDA=","
+8 SET (DDS1Q,DDS1STRT)=$NAME(@DDS1RT@(DDS1IND,DDS1VAL))
SET DDS1SCNT=$QLENGTH(DDS1Q)
+9 FOR
SET DDS1Q=$QUERY(@DDS1Q)
if DDS1Q=""
QUIT
if $NAME(@DDS1Q,DDS1SCNT)'=DDS1STRT
QUIT
Begin DoDot:2
+10 SET DA=$QSUBSCRIPT(DDS1Q,$QLENGTH(DDS1Q))
DO REPLD
End DoDot:2
End DoDot:1
+11 ;
+12 IF '$TEST
SET DIERR=1
QUIT
+13 ;Now set INITIAL POSITION
DISV IF DDS1INI="u"
SET DDS1INI="l"
IF $GET(DUZ)]""
IF $GET(DIE)]""
Begin DoDot:1
+1 NEW T
+2 ;Get entry that SPACE-BAR would return
SET T=$GET(^DISV(DUZ,DIE))
if 'T
QUIT
SET T=$GET(@DDS1REF@(DDS1PDA,"B",T_","))
if 'T
QUIT
+3 SET DDS1SN=T
SET T=T-DDS1REP+1
+4 IF T>0
SET DDS1INI=T_U_(DDS1SN-T+1)_U_DDS1SN
QUIT
+5 SET DDS1INI=1_U_DDS1SN_U_DDS1SN
End DoDot:1
IF DDS1INI
+6 IF '$TEST
IF DDS1INI="l"!(DDS1INI="n")
Begin DoDot:1
+7 NEW N,T
+8 SET N=DDS1INI="n"
F ;Don't want 1^0^0
SET DDS1SN=$ORDER(@DDS1REF@(DDS1PDA," "),-1)+N
if 'DDS1SN
SET DDS1SN=1
+1 SET T=DDS1SN-DDS1REP+2-N
+2 SET DDS1INI=$SELECT(T<1:1_U_DDS1SN,1:T_U_(DDS1REP-'N))_U_DDS1SN
End DoDot:1
+3 IF '$TEST
SET DDS1INI="1^1^1"
+4 ;
+5 SET $PIECE(@DDS1REF@(DDS1PDA),U,2,6)=DDS1PDA_U_DDS1INI_U_+DDS1REP
+6 ;
+7 IF DDS1MUL
Begin DoDot:1
+8 DO UDA^DDS5(.DA,.DDSDL)
+9 SET DDSDA=$PIECE(DDSDA,",",2,999)
End DoDot:1
+10 QUIT
+11 ;
REPLD ;Load data
+1 if '$DATA(@DDS1RT@(DA,0))
QUIT
IF $DATA(DDS1FSCR)
NEW Y
SET Y=DA
XECUTE DDS1FSCR
if '$TEST
QUIT
+2 IF $DATA(DDS1ACT)
Begin DoDot:1
+3 NEW DIC,Y
+4 SET DIC(0)="E"
SET Y=DA_U_$PIECE(@DDS1RT@(DA,0),U)
+5 ;HERE IS WHERE ACCESS AUDITING WOULD TAKE PLACE IF IT IS SET UP IN POST-ACTION!
XECUTE DDS1ACT
End DoDot:1
NOFILE SET DDS1SN=DDS1SN+1
SET $PIECE(DDSDA,",")=DA
SET @("D"_DDSDL)=DA
+1 SET @DDS1REF@(DDS1PDA,DDS1SN)=DDSDA
+2 SET @DDS1REF@(DDS1PDA,"B",DDSDA)=DDS1SN
+3 DO EN^DDS11(DDS1B)
+4 QUIT
+5 ;
D0(DL) ;Given DL, return string D0,D1,...,Dn
+1 NEW I,S
+2 SET S=""
FOR I=0:1:DL
SET S=S_"D"_I_","
+3 if S?.E1","
SET S=$EXTRACT(S,1,$LENGTH(S)-1)
+4 QUIT S
+5 ;
GETD0(DA,DL) ;Given DA array, set D0,D1...
+1 NEW I
+2 SET @("D"_DL)=DA
+3 FOR I=1:1:DL-1
SET @("D"_(DL-I))=DA(I)
+4 QUIT
