- 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 Feb 19, 2025@00:09:38 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