- DDSVALF ;SFISC/MKO-GET,PUT VALUES FOR FORM ONLY FIELDS ;2OCT2003
- ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- ;;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.
- ;
- GET(DDSVFD,DDSVBK,DDSVPG,DDSPARM,DDSVDA) ;Get value
- ;In: DDSPG = Current page
- ; DDSBK = Current block
- ; DDSPARM = "I" : internal, "E" : external form
- ;
- N DDSANS,DDSFLD,DDSVDDP,DIERR
- I $D(DDSPG)[0 N DDSPG S DDSPG=0
- I $D(DDSBK)[0 N DDSBK S DDSBK=0
- S DDSANS=""
- I $G(DDSPARM)'["I",$G(DDSPARM)'["E" S DDSPARM=$G(DDSPARM)_"I"
- ;
- S DDSFLD=$P($$GETFLD^DDSLIB($G(DDSVFD),$G(DDSVBK),$G(DDSVPG),DDS,$G(DDSPG),$G(DDSBK),"F"),",",1,2)
- G:$G(DIERR) GETQ
- ;
- S DDSVFD=+DDSFLD,DDSVBK=+$P(DDSFLD,",",2)
- ;
- S DDSVDDP=+$P($G(^DIST(.404,DDSVBK,0)),U,2)
- I DDSVDDP,$G(DDSVDA)]"" N DDSDA D
- . I DDSVDA'["," S DDSVDA=$$IENS^DILF(.DDSVDA)
- . E S:DDSVDA'?.E1"," DDSVDA=DDSVDA_","
- . S DDSDA=DDSVDA
- E I DDSVDDP,DDSVBK'=DDSBK N DDSDA D GL^DDS10(DDSVDDP,.DDSDAORG,"","",.DDSDA)
- ;
- I $D(@DDSREFT@("F0",DDSDA,DDSFLD,"D"))#2 S DDSANS=^("D") S:DDSPARM["E"&($D(^("X"))#2) DDSANS=^("X") G GETQ
- ;
- I "013"[$P(^DIST(.404,DDSVBK,40,DDSVFD,0),U,3) D BLD^DIALOG(520,"DD or caption-only") G GETQ
- ;
- ;Form-only fields
- I $P($G(^DIST(.404,DDSVBK,40,DDSVFD,0)),U,3)=2 D G:$G(DIERR) GETQ
- . I $P($G(^DIST(.404,DDSVBK,40,DDSVFD,20)),U)="" D Q
- .. N P S P(1)="READ TYPE",P(2)="FIELD multiple of the BLOCK"
- .. D BLD^DIALOG(3011,.P)
- . D:$D(^DIST(.404,DDSVBK,40,DDSVFD,3))#2 DEF(^(3),$G(^(3.1)),.DDSANS)
- . S (@DDSREFT@("F0",DDSDA,DDSFLD,"D"),^("O"))=DDSANS
- . I DDSANS]"" D
- .. D:$D(DDSANS(0))
- ... S @DDSREFT@("F0",DDSDA,DDSFLD,"X")=$G(DDSANS(0,0),DDSANS(0))
- ... S:DDSPARM["E" DDSANS=$G(DDSANS(0,0),DDSANS(0))
- .. S $P(@DDSREFT@("F0",DDSDA,DDSFLD,"F"),U)=3,DDSCHG=1
- ;
- ;Computed fields
- E S:$P($G(^DIST(.404,DDSVBK,40,DDSVFD,0)),U,3)=4 DDSANS=$$VAL^DDSCOMP(DDSVFD,DDSVBK,DDSDA)
- ;
- GETQ D:$G(DIERR) ERR^DDSVALM("$$GET^DDSVALF")
- Q DDSANS
- ;
- PUT(DDSVFD,DDSVBK,DDSVPG,DDSVAL,DDSPARM,DDSVDA) ;Put value
- N DIR,X,Y
- N DDER,DDSFLD,DDSVDDP,DDSVX,DIERR
- I $D(DDSPG)[0 N DDSPG S DDSPG=0
- I $D(DDSBK)[0 N DDSBK S DDSBK=0
- S:$D(DDSVAL)[0 DDSVAL=""
- I $G(DDSPARM)'["I",$G(DDSPARM)'["E" S DDSPARM=$G(DDSPARM)_"E"
- ;
- S DDSFLD=$$GETFLD^DDSLIB($G(DDSVFD),$G(DDSVBK),$G(DDSVPG),DDS,DDSPG,DDSBK,"F")
- G:$G(DIERR) PUTQ
- S DDSVFD=+DDSFLD,DDSVBK=+$P(DDSFLD,",",2),DDSVPG=$P(DDSFLD,",",3)
- S DDSFLD=$P(DDSFLD,",",1,2)
- ;
- S DDSVDDP=+$P($G(^DIST(.404,DDSVBK,0)),U,2)
- I DDSVDDP,$G(DDSVDA)]"" N DDSDA D
- . I DDSVDA'["," S DDSVDA=$$IENS^DILF(.DDSVDA)
- . E S:DDSVDA'?.E1"," DDSVDA=DDSVDA_","
- . S DDSDA=DDSVDA
- E I DDSVDDP,DDSVBK'=DDSBK N DDSDA D GL^DDS10(DDSVDDP,.DDSDAORG,"","",.DDSDA)
- ;
- I $P(^DIST(.404,DDSVBK,40,DDSVFD,0),U,3)'=2 D BLD^DIALOG(520,"DD, computed, or caption-only") G PUTQ
- ;
- S DIR(0)=$P(^DIST(.404,DDSVBK,40,DDSVFD,20),U)_$P(^(20),U,2,3)
- I DDSPARM["I",$E(DIR(0))="P"!(DIR(0)?1"DD".E) D
- . N FIL,FILROOT,FLD
- . S Y=DDSVAL
- . I $E(DIR(0))="P" D
- .. S FIL=$P($P(DIR(0),U,2),":")
- .. I 'FIL S FILROOT=U_FIL,FIL=+$P($G(@(U_FIL_"0)")),U,2) Q:'FIL
- .. E S FILROOT=$G(^DIC(FIL,0,"GL")) Q:FILROOT=""
- .. S Y(0)=$P($G(@(FILROOT_Y_",0)")),U)
- .. S Y(0)=$$EXTERNAL^DILFD(FIL,.01,"",Y(0))
- . E D
- .. N DV,I S FIL=$P($P(DIR(0),","),U,2),FLD=$P(DIR(0),",",2)
- .. S DV=$P($G(^DD(FIL,FLD,0)),U,2)
- .. F I="O","P","V","D","S" I DV[I S Y(0)=$$EXTERNAL^DILFD(FIL,FLD,"",Y) Q
- E D G:$G(DDER) PUTQ
- . I DDSVAL="" D Q
- .. N DDSVREQ
- .. S DDSVREQ=$P($G(@DDSREFT@(DDSVPG,DDSVBK,DDSVFD)),U)
- .. S:DDSVREQ]"" DDSVREQ=$P($G(^DIST(.404,DDSVBK,40,DDSVFD,4)),U)
- .. I DDSVREQ S DDER=1
- .. E S Y=""
- . S DIR("V")="",(X,DIR("B"))=DDSVAL
- . S:DIR(0)?1"DD".E DIR(0)=$P(DIR(0),U,2,999)
- . I $P(DIR(0),U)["P",$P($P(DIR(0),U,2),":",2)'["Z" D
- .. N I
- .. S I=$P(DIR(0),U,2) Q:$P(I,":",2)["Z"
- .. S $P(I,":",2)=$P(I,":",2)_"Z"
- .. S $P(DIR(0),U,2)=I
- . D ^DIR
- . I $E($P(DIR(0),U))="P" S Y=$P(Y,U)
- ;
- ;Update ^TMP
- S DDSCHG=1
- S (DDSVX,@DDSREFT@("F0",DDSDA,DDSFLD,"D"))=Y,^("F")=3 S:$D(Y(0))#2 (DDSVX,^("X"))=$S($D(Y(0,0))#2:Y(0,0),1:Y(0)) I $D(^("X"))#2,Y="" S (DDSVX,^("X"))=""
- ;
- ;Repaint field if it appears on the current page
- I $D(@DDSREFS@("F0",DDSFLD,"L",DDSPG,DDSVBK,DDSVFD))#2 D
- . N DY,DX,DDSVL,DDSVRJ,DDSX,DDSVREP
- . S DDSVREP=$P($G(@DDSREFS@(DDSPG,DDSVBK)),U,7)
- . S DY=+@DDSREFS@(DDSPG,DDSVBK,DDSVFD,"D"),DX=$P(^("D"),U,2),DDSVL=$P(^("D"),U,3),DDSVRJ=$P(^("D"),U,10)
- . I $G(DDSVREP) D Q:DY=""
- .. N DDSVSN,DDSVPDA,DDSVOFS
- .. S DDSVPDA=$G(@DDSREFT@(DDSPG,DDSVBK)) I 'DDSVPDA S DY="" Q
- .. S DDSVREP=$P($G(@DDSREFT@(DDSPG,DDSVBK,DDSVPDA)),U,2,999) I DDSVREP="" S DY="" Q
- .. S DDSVSN=$G(@DDSREFT@(DDSPG,DDSVBK,DDSVPDA,"B",DDSDA)) I 'DDSVSN S DY="" Q
- HITE .. N HITE S HITE=$$HITE^DDSR(DDSVBK),DDSVOFS=DDSVSN-$P(DDSVREP,U,2)*HITE ;DJW/GFT
- .. I DDSVOFS'<0,$P(DDSVREP,U,5)*HITE>DDSVOFS S DY=DY+DDSVOFS ;GFT OFFSET CAN'T BE OUTSIDE SCROLLING WINDOW
- .. E S DY=""
- . S DDSX=$P(DDGLVID,DDGLDEL)_$E(DDSVX,1,DDSVL)_$P(DDGLVID,DDGLDEL,10)
- . X IOXY
- . W $S(DDSVRJ:$J("",DDSVL-$L(DDSVX))_DDSX,1:DDSX_$J("",DDSVL-$L(DDSVX)))
- ;
- D
- . N DDP,DDSDA S DDP=0,DDSDA="0,"
- . D:$D(@DDSREFS@("PT",DDP,DDSFLD)) RPB^DDS7(DDP,DDSFLD,DDSPG)
- . D:$D(@DDSREFS@("COMP",DDP,DDSFLD,DDSPG)) RPCF^DDSCOMP(DDSPG)
- ;
- PUTQ D:$G(DIERR) ERR^DDSVALM("PUT^DDSVALF")
- Q
- ;
- DEF(DDSLN3,DDSLN31,Y) ;Get default
- N DDER,DIR,X
- Q:DDSLN3=""
- ;
- I DDSLN3'="!M" S Y=DDSLN3
- E I DDSLN31'?."^" X DDSLN31 S:$D(Y)[0 Y=""
- Q:Y=""
- ;
- S DIR(0)=$P(^DIST(.404,DDSVBK,40,DDSVFD,20),U)_$P(^(20),U,2,3)
- S:DIR(0)?1"DD".E DIR(0)=$P(DIR(0),U,2,999)
- S DIR("V")="",(X,DIR("B"))=Y
- D ^DIR I DDER K Y S Y=""
- ;
- I Y]"",$E($P(DIR(0),U))="P" S Y=$P(Y,U)
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDSVALF 5888 printed Jan 18, 2025@03:44:37 Page 2
- DDSVALF ;SFISC/MKO-GET,PUT VALUES FOR FORM ONLY FIELDS ;2OCT2003
- +1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- +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 ;
- GET(DDSVFD,DDSVBK,DDSVPG,DDSPARM,DDSVDA) ;Get value
- +1 ;In: DDSPG = Current page
- +2 ; DDSBK = Current block
- +3 ; DDSPARM = "I" : internal, "E" : external form
- +4 ;
- +5 NEW DDSANS,DDSFLD,DDSVDDP,DIERR
- +6 IF $DATA(DDSPG)[0
- NEW DDSPG
- SET DDSPG=0
- +7 IF $DATA(DDSBK)[0
- NEW DDSBK
- SET DDSBK=0
- +8 SET DDSANS=""
- +9 IF $GET(DDSPARM)'["I"
- IF $GET(DDSPARM)'["E"
- SET DDSPARM=$GET(DDSPARM)_"I"
- +10 ;
- +11 SET DDSFLD=$PIECE($$GETFLD^DDSLIB($GET(DDSVFD),$GET(DDSVBK),$GET(DDSVPG),DDS,$GET(DDSPG),$GET(DDSBK),"F"),",",1,2)
- +12 if $GET(DIERR)
- GOTO GETQ
- +13 ;
- +14 SET DDSVFD=+DDSFLD
- SET DDSVBK=+$PIECE(DDSFLD,",",2)
- +15 ;
- +16 SET DDSVDDP=+$PIECE($GET(^DIST(.404,DDSVBK,0)),U,2)
- +17 IF DDSVDDP
- IF $GET(DDSVDA)]""
- NEW DDSDA
- Begin DoDot:1
- +18 IF DDSVDA'[","
- SET DDSVDA=$$IENS^DILF(.DDSVDA)
- +19 IF '$TEST
- if DDSVDA'?.E1","
- SET DDSVDA=DDSVDA_","
- +20 SET DDSDA=DDSVDA
- End DoDot:1
- +21 IF '$TEST
- IF DDSVDDP
- IF DDSVBK'=DDSBK
- NEW DDSDA
- DO GL^DDS10(DDSVDDP,.DDSDAORG,"","",.DDSDA)
- +22 ;
- +23 IF $DATA(@DDSREFT@("F0",DDSDA,DDSFLD,"D"))#2
- SET DDSANS=^("D")
- if DDSPARM["E"&($DATA(^("X"))#2)
- SET DDSANS=^("X")
- GOTO GETQ
- +24 ;
- +25 IF "013"[$PIECE(^DIST(.404,DDSVBK,40,DDSVFD,0),U,3)
- DO BLD^DIALOG(520,"DD or caption-only")
- GOTO GETQ
- +26 ;
- +27 ;Form-only fields
- +28 IF $PIECE($GET(^DIST(.404,DDSVBK,40,DDSVFD,0)),U,3)=2
- Begin DoDot:1
- +29 IF $PIECE($GET(^DIST(.404,DDSVBK,40,DDSVFD,20)),U)=""
- Begin DoDot:2
- +30 NEW P
- SET P(1)="READ TYPE"
- SET P(2)="FIELD multiple of the BLOCK"
- +31 DO BLD^DIALOG(3011,.P)
- End DoDot:2
- QUIT
- +32 if $DATA(^DIST(.404,DDSVBK,40,DDSVFD,3))#2
- DO DEF(^(3),$GET(^(3.1)),.DDSANS)
- +33 SET (@DDSREFT@("F0",DDSDA,DDSFLD,"D"),^("O"))=DDSANS
- +34 IF DDSANS]""
- Begin DoDot:2
- +35 if $DATA(DDSANS(0))
- Begin DoDot:3
- +36 SET @DDSREFT@("F0",DDSDA,DDSFLD,"X")=$GET(DDSANS(0,0),DDSANS(0))
- +37 if DDSPARM["E"
- SET DDSANS=$GET(DDSANS(0,0),DDSANS(0))
- End DoDot:3
- +38 SET $PIECE(@DDSREFT@("F0",DDSDA,DDSFLD,"F"),U)=3
- SET DDSCHG=1
- End DoDot:2
- End DoDot:1
- if $GET(DIERR)
- GOTO GETQ
- +39 ;
- +40 ;Computed fields
- +41 IF '$TEST
- if $PIECE($GET(^DIST(.404,DDSVBK,40,DDSVFD,0)),U,3)=4
- SET DDSANS=$$VAL^DDSCOMP(DDSVFD,DDSVBK,DDSDA)
- +42 ;
- GETQ if $GET(DIERR)
- DO ERR^DDSVALM("$$GET^DDSVALF")
- +1 QUIT DDSANS
- +2 ;
- PUT(DDSVFD,DDSVBK,DDSVPG,DDSVAL,DDSPARM,DDSVDA) ;Put value
- +1 NEW DIR,X,Y
- +2 NEW DDER,DDSFLD,DDSVDDP,DDSVX,DIERR
- +3 IF $DATA(DDSPG)[0
- NEW DDSPG
- SET DDSPG=0
- +4 IF $DATA(DDSBK)[0
- NEW DDSBK
- SET DDSBK=0
- +5 if $DATA(DDSVAL)[0
- SET DDSVAL=""
- +6 IF $GET(DDSPARM)'["I"
- IF $GET(DDSPARM)'["E"
- SET DDSPARM=$GET(DDSPARM)_"E"
- +7 ;
- +8 SET DDSFLD=$$GETFLD^DDSLIB($GET(DDSVFD),$GET(DDSVBK),$GET(DDSVPG),DDS,DDSPG,DDSBK,"F")
- +9 if $GET(DIERR)
- GOTO PUTQ
- +10 SET DDSVFD=+DDSFLD
- SET DDSVBK=+$PIECE(DDSFLD,",",2)
- SET DDSVPG=$PIECE(DDSFLD,",",3)
- +11 SET DDSFLD=$PIECE(DDSFLD,",",1,2)
- +12 ;
- +13 SET DDSVDDP=+$PIECE($GET(^DIST(.404,DDSVBK,0)),U,2)
- +14 IF DDSVDDP
- IF $GET(DDSVDA)]""
- NEW DDSDA
- Begin DoDot:1
- +15 IF DDSVDA'[","
- SET DDSVDA=$$IENS^DILF(.DDSVDA)
- +16 IF '$TEST
- if DDSVDA'?.E1","
- SET DDSVDA=DDSVDA_","
- +17 SET DDSDA=DDSVDA
- End DoDot:1
- +18 IF '$TEST
- IF DDSVDDP
- IF DDSVBK'=DDSBK
- NEW DDSDA
- DO GL^DDS10(DDSVDDP,.DDSDAORG,"","",.DDSDA)
- +19 ;
- +20 IF $PIECE(^DIST(.404,DDSVBK,40,DDSVFD,0),U,3)'=2
- DO BLD^DIALOG(520,"DD, computed, or caption-only")
- GOTO PUTQ
- +21 ;
- +22 SET DIR(0)=$PIECE(^DIST(.404,DDSVBK,40,DDSVFD,20),U)_$PIECE(^(20),U,2,3)
- +23 IF DDSPARM["I"
- IF $EXTRACT(DIR(0))="P"!(DIR(0)?1"DD".E)
- Begin DoDot:1
- +24 NEW FIL,FILROOT,FLD
- +25 SET Y=DDSVAL
- +26 IF $EXTRACT(DIR(0))="P"
- Begin DoDot:2
- +27 SET FIL=$PIECE($PIECE(DIR(0),U,2),":")
- +28 IF 'FIL
- SET FILROOT=U_FIL
- SET FIL=+$PIECE($GET(@(U_FIL_"0)")),U,2)
- if 'FIL
- QUIT
- +29 IF '$TEST
- SET FILROOT=$GET(^DIC(FIL,0,"GL"))
- if FILROOT=""
- QUIT
- +30 SET Y(0)=$PIECE($GET(@(FILROOT_Y_",0)")),U)
- +31 SET Y(0)=$$EXTERNAL^DILFD(FIL,.01,"",Y(0))
- End DoDot:2
- +32 IF '$TEST
- Begin DoDot:2
- +33 NEW DV,I
- SET FIL=$PIECE($PIECE(DIR(0),","),U,2)
- SET FLD=$PIECE(DIR(0),",",2)
- +34 SET DV=$PIECE($GET(^DD(FIL,FLD,0)),U,2)
- +35 FOR I="O","P","V","D","S"
- IF DV[I
- SET Y(0)=$$EXTERNAL^DILFD(FIL,FLD,"",Y)
- QUIT
- End DoDot:2
- End DoDot:1
- +36 IF '$TEST
- Begin DoDot:1
- +37 IF DDSVAL=""
- Begin DoDot:2
- +38 NEW DDSVREQ
- +39 SET DDSVREQ=$PIECE($GET(@DDSREFT@(DDSVPG,DDSVBK,DDSVFD)),U)
- +40 if DDSVREQ]""
- SET DDSVREQ=$PIECE($GET(^DIST(.404,DDSVBK,40,DDSVFD,4)),U)
- +41 IF DDSVREQ
- SET DDER=1
- +42 IF '$TEST
- SET Y=""
- End DoDot:2
- QUIT
- +43 SET DIR("V")=""
- SET (X,DIR("B"))=DDSVAL
- +44 if DIR(0)?1"DD".E
- SET DIR(0)=$PIECE(DIR(0),U,2,999)
- +45 IF $PIECE(DIR(0),U)["P"
- IF $PIECE($PIECE(DIR(0),U,2),":",2)'["Z"
- Begin DoDot:2
- +46 NEW I
- +47 SET I=$PIECE(DIR(0),U,2)
- if $PIECE(I,"
- QUIT
- +48 SET $PIECE(I,":",2)=$PIECE(I,":",2)_"Z"
- +49 SET $PIECE(DIR(0),U,2)=I
- End DoDot:2
- +50 DO ^DIR
- +51 IF $EXTRACT($PIECE(DIR(0),U))="P"
- SET Y=$PIECE(Y,U)
- End DoDot:1
- if $GET(DDER)
- GOTO PUTQ
- +52 ;
- +53 ;Update ^TMP
- +54 SET DDSCHG=1
- +55 SET (DDSVX,@DDSREFT@("F0",DDSDA,DDSFLD,"D"))=Y
- SET ^("F")=3
- if $DATA(Y(0))#2
- SET (DDSVX,^("X"))=$SELECT($DATA(Y(0,0))#2:Y(0,0),1:Y(0))
- IF $DATA(^("X"))#2
- IF Y=""
- SET (DDSVX,^("X"))=""
- +56 ;
- +57 ;Repaint field if it appears on the current page
- +58 IF $DATA(@DDSREFS@("F0",DDSFLD,"L",DDSPG,DDSVBK,DDSVFD))#2
- Begin DoDot:1
- +59 NEW DY,DX,DDSVL,DDSVRJ,DDSX,DDSVREP
- +60 SET DDSVREP=$PIECE($GET(@DDSREFS@(DDSPG,DDSVBK)),U,7)
- +61 SET DY=+@DDSREFS@(DDSPG,DDSVBK,DDSVFD,"D")
- SET DX=$PIECE(^("D"),U,2)
- SET DDSVL=$PIECE(^("D"),U,3)
- SET DDSVRJ=$PIECE(^("D"),U,10)
- +62 IF $GET(DDSVREP)
- Begin DoDot:2
- +63 NEW DDSVSN,DDSVPDA,DDSVOFS
- +64 SET DDSVPDA=$GET(@DDSREFT@(DDSPG,DDSVBK))
- IF 'DDSVPDA
- SET DY=""
- QUIT
- +65 SET DDSVREP=$PIECE($GET(@DDSREFT@(DDSPG,DDSVBK,DDSVPDA)),U,2,999)
- IF DDSVREP=""
- SET DY=""
- QUIT
- +66 SET DDSVSN=$GET(@DDSREFT@(DDSPG,DDSVBK,DDSVPDA,"B",DDSDA))
- IF 'DDSVSN
- SET DY=""
- QUIT
- HITE ;DJW/GFT
- NEW HITE
- SET HITE=$$HITE^DDSR(DDSVBK)
- SET DDSVOFS=DDSVSN-$PIECE(DDSVREP,U,2)*HITE
- +1 ;GFT OFFSET CAN'T BE OUTSIDE SCROLLING WINDOW
- IF DDSVOFS'<0
- IF $PIECE(DDSVREP,U,5)*HITE>DDSVOFS
- SET DY=DY+DDSVOFS
- +2 IF '$TEST
- SET DY=""
- End DoDot:2
- if DY=""
- QUIT
- +3 SET DDSX=$PIECE(DDGLVID,DDGLDEL)_$EXTRACT(DDSVX,1,DDSVL)_$PIECE(DDGLVID,DDGLDEL,10)
- +4 XECUTE IOXY
- +5 WRITE $SELECT(DDSVRJ:$JUSTIFY("",DDSVL-$LENGTH(DDSVX))_DDSX,1:DDSX_$JUSTIFY("",DDSVL-$LENGTH(DDSVX)))
- End DoDot:1
- +6 ;
- +7 Begin DoDot:1
- +8 NEW DDP,DDSDA
- SET DDP=0
- SET DDSDA="0,"
- +9 if $DATA(@DDSREFS@("PT",DDP,DDSFLD))
- DO RPB^DDS7(DDP,DDSFLD,DDSPG)
- +10 if $DATA(@DDSREFS@("COMP",DDP,DDSFLD,DDSPG))
- DO RPCF^DDSCOMP(DDSPG)
- End DoDot:1
- +11 ;
- PUTQ if $GET(DIERR)
- DO ERR^DDSVALM("PUT^DDSVALF")
- +1 QUIT
- +2 ;
- DEF(DDSLN3,DDSLN31,Y) ;Get default
- +1 NEW DDER,DIR,X
- +2 if DDSLN3=""
- QUIT
- +3 ;
- +4 IF DDSLN3'="!M"
- SET Y=DDSLN3
- +5 IF '$TEST
- IF DDSLN31'?."^"
- XECUTE DDSLN31
- if $DATA(Y)[0
- SET Y=""
- +6 if Y=""
- QUIT
- +7 ;
- +8 SET DIR(0)=$PIECE(^DIST(.404,DDSVBK,40,DDSVFD,20),U)_$PIECE(^(20),U,2,3)
- +9 if DIR(0)?1"DD".E
- SET DIR(0)=$PIECE(DIR(0),U,2,999)
- +10 SET DIR("V")=""
- SET (X,DIR("B"))=Y
- +11 DO ^DIR
- IF DDER
- KILL Y
- SET Y=""
- +12 ;
- +13 IF Y]""
- IF $EXTRACT($PIECE(DIR(0),U))="P"
- SET Y=$PIECE(Y,U)
- +14 QUIT
- +15 ;