DDSM1 ;SFISC/MKO-MULTILINE, LOAD AND DELETE ;2015-01-02 5:49 PM
;;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.
;
LOAD(DDSIEN) ;Load subentries
MLOAD ;Entry point from MLOAD^DDSUTL
;@DDSIEN is an array of record numbers
;
Q:$D(DDSIEN)[0
Q:$D(@DDSIEN)<9
;
N DDSI,DDSPDA,DDSRN,DDSSN
S DDSPDA=$P(DDSREP,U)
S DDSSN=$O(@DDSREFT@(DDSPG,DDSBK,DDSPDA," "),-1)
;
;Add records to internal ^TMP array
;Load data for each record
S DDSI="" F S DDSI=$O(@DDSIEN@(DDSI)) Q:DDSI="" D
. S DDSRN=@DDSIEN@(DDSI) Q:'DDSRN
. S DA=+DDSRN,$P(DDSDA,",")=DA,@("D"_DDSDL)=DA
. I $D(@DDSREFT@(DDSPG,DDSBK,DDSPDA,"B",DDSDA))[0 D
.. S DDSSN=DDSSN+1
.. S @DDSREFT@(DDSPG,DDSBK,DDSPDA,"B",DDSDA)=DDSSN
.. S @DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN)=DDSDA
.. S ^("ADD")=$G(@DDSREFT@("ADD"))+1,^("ADD",^("ADD"))=DDSDA_DIE
. D EN^DDS11(DDSBK)
. S DDSCHG=1
;
;Position the cursor on blank (Select) line
;Repaint all lines in the repeating block
D POSSN^DDSM(999999999999)
D DMULTN^DDSR(DDSPG,DDSBK,DDSPDA,$P(DDSREP,U,5),1)
;
;Update DIR0
DIR0 S DIR0=$P(@DDSREFS@(DDSPG,DDSBK,DDO,"D"),U,1,3)
S:$P($G(DDSREP),U,3)>1 $P(DIR0,U)=$P(DIR0,U)+($P(DDSREP,U,3)-1*$$HITE^DDSR(DDSBK)) ;DJW/GFT
Q
;
DEL(DDSIEN) ;Delete subentries
MDEL ;Entry point from MDEL^DDSUTL
;In:
; If DDSIEN contains a record number, delete that one (G MDELONE)
; If DDSIEN contains a closed root, @DDSIEN is an array
; of record numbers to delete
; DIE = global root
; DDSDA = current IENS
;
Q:$D(DDSIEN)[0
G:+$P(DDSIEN,"E") MDELONE
Q:$D(@DDSIEN)<9
;
N DDSI,DDSPDA,DDSRN,DDSSN
S DDSPDA=$P(DDSREP,U)
;
;Loop through passed array and delete subentries
S DDSI="" F S DDSI=$O(@DDSIEN@(DDSI)) Q:DDSI="" D
. ;S DDSRN=@DDSIEN@(DDSI) Q:'DDSRN
. ;S DDSIENS=DDSDA,$P(DDSIENS,",")=+DDSRN
. ;D K^DDS6(DDSIENS,DIE)
. ;Q
. ;
. S DDSRN=@DDSIEN@(DDSI) Q:'DDSRN
. S DA=+DDSRN,$P(DDSDA,",")=DA
. S DDSSN=$G(@DDSREFT@(DDSPG,DDSBK,DDSPDA,"B",DDSDA)) Q:'DDSSN
. K @DDSREFT@(DDSPG,DDSBK,DDSPDA,"B",DDSDA)
. K @DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN)
. K @DDSREFT@("F"_DDP,DDSDA)
. K @DDSREFT@("F0",DDSDA)
;
;Close up gaps in ^TMP array
S (DDSI,DDSSN)=0
F S DDSI=$O(@DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSI)) Q:'DDSI D
. S DDSSN=DDSSN+1 Q:DDSI=DDSSN
. S DDSRN=@DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSI)
. S @DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN)=DDSRN
. S @DDSREFT@(DDSPG,DDSBK,DDSPDA,"B",DDSRN)=DDSSN
;
F S DDSSN=$O(@DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN)) Q:'DDSSN D
. K @DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN)
;
;Position cursor on "Select" line
;Repaint all lines in repeating block
D POSSN^DDSM(999999999999,1)
;
;Update DIR0
DIR01 D DIR0
Q
;
MDELONE ;Delete one subentry in the current repeating block
;In: DDSIEN = IENS of record to be deleted
; DDSREP = data for repeating blocks
; DDSDA = current IENS
; DIE = current global root
;
N DDSPDA,DDSRN,DDSSN
;
;Get parent IENS
S DDSPDA=$P(DDSREP,U)
;
;Kill all data pertaining to current (sub)record
D K^DDS6(DDSIEN,DIE)
;
;Repaint lines and reposition cursor
I DDSDA=DDSIEN D
. D DMULTN^DDSR(DDSPG,DDSBK,DDSPDA,$P(DDSREP,U,5),$P(DDSREP,U,3))
. S DDSSN=$P(DDSREP,U,4)
. I $D(@DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN))[0 D
.. S DDSSN=$O(@DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN),-1)
. D POSSN^DDSM(DDSSN)
;
E D POSSN^DDSM(999999999999,1)
;
DIR02 D DIR0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDSM1 3666 printed Oct 16, 2024@18:43:56 Page 2
DDSM1 ;SFISC/MKO-MULTILINE, LOAD AND DELETE ;2015-01-02 5:49 PM
+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 ;
LOAD(DDSIEN) ;Load subentries
MLOAD ;Entry point from MLOAD^DDSUTL
+1 ;@DDSIEN is an array of record numbers
+2 ;
+3 if $DATA(DDSIEN)[0
QUIT
+4 if $DATA(@DDSIEN)<9
QUIT
+5 ;
+6 NEW DDSI,DDSPDA,DDSRN,DDSSN
+7 SET DDSPDA=$PIECE(DDSREP,U)
+8 SET DDSSN=$ORDER(@DDSREFT@(DDSPG,DDSBK,DDSPDA," "),-1)
+9 ;
+10 ;Add records to internal ^TMP array
+11 ;Load data for each record
+12 SET DDSI=""
FOR
SET DDSI=$ORDER(@DDSIEN@(DDSI))
if DDSI=""
QUIT
Begin DoDot:1
+13 SET DDSRN=@DDSIEN@(DDSI)
if 'DDSRN
QUIT
+14 SET DA=+DDSRN
SET $PIECE(DDSDA,",")=DA
SET @("D"_DDSDL)=DA
+15 IF $DATA(@DDSREFT@(DDSPG,DDSBK,DDSPDA,"B",DDSDA))[0
Begin DoDot:2
+16 SET DDSSN=DDSSN+1
+17 SET @DDSREFT@(DDSPG,DDSBK,DDSPDA,"B",DDSDA)=DDSSN
+18 SET @DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN)=DDSDA
+19 SET ^("ADD")=$GET(@DDSREFT@("ADD"))+1
SET ^("ADD",^("ADD"))=DDSDA_DIE
End DoDot:2
+20 DO EN^DDS11(DDSBK)
+21 SET DDSCHG=1
End DoDot:1
+22 ;
+23 ;Position the cursor on blank (Select) line
+24 ;Repaint all lines in the repeating block
+25 DO POSSN^DDSM(999999999999)
+26 DO DMULTN^DDSR(DDSPG,DDSBK,DDSPDA,$PIECE(DDSREP,U,5),1)
+27 ;
+28 ;Update DIR0
DIR0 SET DIR0=$PIECE(@DDSREFS@(DDSPG,DDSBK,DDO,"D"),U,1,3)
+1 ;DJW/GFT
if $PIECE($GET(DDSREP),U,3)>1
SET $PIECE(DIR0,U)=$PIECE(DIR0,U)+($PIECE(DDSREP,U,3)-1*$$HITE^DDSR(DDSBK))
+2 QUIT
+3 ;
DEL(DDSIEN) ;Delete subentries
MDEL ;Entry point from MDEL^DDSUTL
+1 ;In:
+2 ; If DDSIEN contains a record number, delete that one (G MDELONE)
+3 ; If DDSIEN contains a closed root, @DDSIEN is an array
+4 ; of record numbers to delete
+5 ; DIE = global root
+6 ; DDSDA = current IENS
+7 ;
+8 if $DATA(DDSIEN)[0
QUIT
+9 if +$PIECE(DDSIEN,"E")
GOTO MDELONE
+10 if $DATA(@DDSIEN)<9
QUIT
+11 ;
+12 NEW DDSI,DDSPDA,DDSRN,DDSSN
+13 SET DDSPDA=$PIECE(DDSREP,U)
+14 ;
+15 ;Loop through passed array and delete subentries
+16 SET DDSI=""
FOR
SET DDSI=$ORDER(@DDSIEN@(DDSI))
if DDSI=""
QUIT
Begin DoDot:1
+17 ;S DDSRN=@DDSIEN@(DDSI) Q:'DDSRN
+18 ;S DDSIENS=DDSDA,$P(DDSIENS,",")=+DDSRN
+19 ;D K^DDS6(DDSIENS,DIE)
+20 ;Q
+21 ;
+22 SET DDSRN=@DDSIEN@(DDSI)
if 'DDSRN
QUIT
+23 SET DA=+DDSRN
SET $PIECE(DDSDA,",")=DA
+24 SET DDSSN=$GET(@DDSREFT@(DDSPG,DDSBK,DDSPDA,"B",DDSDA))
if 'DDSSN
QUIT
+25 KILL @DDSREFT@(DDSPG,DDSBK,DDSPDA,"B",DDSDA)
+26 KILL @DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN)
+27 KILL @DDSREFT@("F"_DDP,DDSDA)
+28 KILL @DDSREFT@("F0",DDSDA)
End DoDot:1
+29 ;
+30 ;Close up gaps in ^TMP array
+31 SET (DDSI,DDSSN)=0
+32 FOR
SET DDSI=$ORDER(@DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSI))
if 'DDSI
QUIT
Begin DoDot:1
+33 SET DDSSN=DDSSN+1
if DDSI=DDSSN
QUIT
+34 SET DDSRN=@DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSI)
+35 SET @DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN)=DDSRN
+36 SET @DDSREFT@(DDSPG,DDSBK,DDSPDA,"B",DDSRN)=DDSSN
End DoDot:1
+37 ;
+38 FOR
SET DDSSN=$ORDER(@DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN))
if 'DDSSN
QUIT
Begin DoDot:1
+39 KILL @DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN)
End DoDot:1
+40 ;
+41 ;Position cursor on "Select" line
+42 ;Repaint all lines in repeating block
+43 DO POSSN^DDSM(999999999999,1)
+44 ;
+45 ;Update DIR0
DIR01 DO DIR0
+1 QUIT
+2 ;
MDELONE ;Delete one subentry in the current repeating block
+1 ;In: DDSIEN = IENS of record to be deleted
+2 ; DDSREP = data for repeating blocks
+3 ; DDSDA = current IENS
+4 ; DIE = current global root
+5 ;
+6 NEW DDSPDA,DDSRN,DDSSN
+7 ;
+8 ;Get parent IENS
+9 SET DDSPDA=$PIECE(DDSREP,U)
+10 ;
+11 ;Kill all data pertaining to current (sub)record
+12 DO K^DDS6(DDSIEN,DIE)
+13 ;
+14 ;Repaint lines and reposition cursor
+15 IF DDSDA=DDSIEN
Begin DoDot:1
+16 DO DMULTN^DDSR(DDSPG,DDSBK,DDSPDA,$PIECE(DDSREP,U,5),$PIECE(DDSREP,U,3))
+17 SET DDSSN=$PIECE(DDSREP,U,4)
+18 IF $DATA(@DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN))[0
Begin DoDot:2
+19 SET DDSSN=$ORDER(@DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN),-1)
End DoDot:2
+20 DO POSSN^DDSM(DDSSN)
End DoDot:1
+21 ;
+22 IF '$TEST
DO POSSN^DDSM(999999999999,1)
+23 ;
DIR02 DO DIR0
+1 QUIT
