Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DDS6

DDS6.m

Go to the documentation of this file.
  1. DDS6 ;SFISC/MKO-DELETIONS ;14NOV2012
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. ;Enter here if user deleted record from the .01 of the (sub)record
  1. ;(called from DDS01)
  1. ;In: DDSU array, DDSOLD, DDSFLD
  1. D D
  1. I 'Y D ;DELETE DIDN'T HAPPEN
  1. . S @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D")=DDSOLD
  1. . S:$D(DDSU("X"))#2 @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"X")=DDSU("X")
  1. E D
  1. . I $D(DDSREP) D
  1. .. D DEL^DDSM1(DDSDA) ;THIS WILL COME BACK TO K IN THIS ROUTINE!
  1. . E D K(DDSDA,DIE) I $D(DDSPTB) D
  1. .. S DDACT="NB"
  1. .. S $P(@DDSREFT@(DDSPG,DDSBK),U)=""
  1. .. D DB^DDSR(DDSPG,DDSBK)
  1. .. D RPF^DDS7(DDP,DDSPTB,DDSDA,.DA)
  1. . E S DDACT="Q",DA="",DDSDAORG=DA,DDSDA="0,"
  1. . I '$D(DDSPTB),'$P(DDSSC(DDSSC),U,4),'$D(DDSREP) D
  1. .. D PG^DDSRSEL
  1. .. I $G(DDSSEL) D
  1. ... D CLRDAT^DDSRSEL
  1. ... D R^DDSR
  1. ... D PUT^DDSVALF(1,1,$P(^DIST(.403,+DDS,21),U),"","","0,")
  1. Q
  1. ;
  1. DM ;Enter here if user deleted record from the Select prompt
  1. ;(called from DDS5)
  1. ;In: DDSU array, DDSOLD, DDSFLD
  1. ;
  1. ;Get DA and DIE for subfile level and delete
  1. D DDA^DDS5(DDSOLD,.DA,.DDSDL)
  1. D
  1. . N DIE,DDSDA
  1. . S DIE=U_$P(DDSU("M"),U,2)
  1. . S DDSDA=DA_"," F DDSI=1:1:DDSDL S DDSDA=DDSDA_DA(DDSI)_","
  1. . K DDSI
  1. . D D
  1. . D:Y K(DDSDA,DIE)
  1. ;
  1. I 'Y D
  1. . S @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D")=DDSOLD
  1. . S:$D(DDSU("X"))#2 @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"X")=DDSU("X")
  1. . D UDA^DDS5(.DA,.DDSDL)
  1. E D
  1. . D LST^DDS5(.DA,.DDSDL,DDP,DDSDA,DDSFLD)
  1. . D UDA^DDS5(.DA,.DDSDL)
  1. Q
  1. ;
  1. D ;Delete the subrecord
  1. ;In: DA array, DIE, DDSDL; Out: Y=1 if successful
  1. N DR,DDS6DA,DDSI
  1. D:DDM CLRMSG^DDS
  1. S DDM=1
  1. ;
  1. K DIR S DIR(0)="YO"
  1. D BLD^DIALOG(8080,$$EZBLD^DIALOG(8078+(DDSDL>0)),"","DIR(""A"")")
  1. D BLD^DIALOG(9038,"","","DIR(""?"")")
  1. ;
  1. S DIR0=IOSL-1_U_($L(DIR("A"))+1)_"^3^"_(IOSL-3)_"^0"
  1. D ^DIR K DIR
  1. D CLRMSG^DDS
  1. I X=""!$D(DIRUT)!'Y S Y=0 K DIRUT,DUOUT,DIROUT,DTOUT Q
  1. ;
  1. S DDS6DA=DA N D0
  1. F DDSI=1:1 Q:$D(DA(DDSI))[0 S DDS6DA(DDSI)=DA(DDSI) N @("D"_DDSI)
  1. W $P(DDGLVID,DDGLDEL,9) S X=IOM X DDGLZOSF("RM")
  1. S DR=".01///@" D ^DIE K DI ;DELETE THE SUB-RECORD!
  1. W $P(DDGLVID,DDGLDEL,8) S X=0 X DDGLZOSF("RM")
  1. ;
  1. ;I $D(DA) H 2 W $P(DDGLCLR,DDGLDEL,2) D R^DDSR S Y=0 Q
  1. I $D(DA) S:$Y>(DDSHBX+1) DDSKM=1,DDM=1 S Y=0 Q
  1. ;
  1. S Y=1,DA=DDS6DA
  1. I '$G(DDSCHANG),$G(DDSPARM)["C" S DDSCHANG=1
  1. F DDSI=1:1 Q:$D(DDS6DA(DDSI))[0 S DA(DDSI)=DDS6DA(DDSI)
  1. Q
  1. ;
  1. K(DDSIEN,DIE) ;Remove all data pertaining to the (sub)record from @DDSREFT
  1. ;In: DDSIEN = IENS of record being deleted
  1. ; DIE = global root
  1. ;
  1. N B,P,FN,PAT,PDA,IENS
  1. S PAT=".E1"""_DDSIEN_""""
  1. ;
  1. ;Loop through all pages/blocks in ^TMP
  1. S P=0 F S P=$O(@DDSREFT@(P)) Q:'P D
  1. . S B=0 F S B=$O(@DDSREFT@(P,B)) Q:'B D
  1. .. ;Get file number of the block
  1. .. S FN="F"_$P(@DDSREFS@(P,B),U,3)
  1. .. ;
  1. .. ;Loop through all records loaded for that block
  1. .. S IENS=" "
  1. B .. F S IENS=$O(@DDSREFT@(P,B,IENS)) Q:IENS'["," D
  1. ... ;
  1. ... ;If the data pertains to the current or ancestor file, kill it
  1. ... ;Get the parent IENS (also indicates the block is repeating)
  1. ... S PDA=$P($G(@DDSREFT@(P,B,IENS)),U,2)
  1. ... ;
  1. ... I 'PDA,IENS?@PAT,$P(@DDSREFT@(P,B,IENS,"GL"),DIE)="" D
  1. .... K @DDSREFT@(P,B,IENS)
  1. .... K @DDSREFT@(FN,IENS)
  1. SUB ... E I $P($G(@DDSREFT@(P,B,IENS)),U,6)!PDA,@DDSREFT@(P,B,IENS,"GL")=DIE D ;IF IT'S A MULTIPLE IN A REPEATING BLOCK
  1. .... D DELP(P,B,PDA,DDSIEN)
  1. .... K @DDSREFT@(FN,DDSIEN)
  1. Q
  1. ;
  1. DELP(P,B,PDA,IENS) ;Delete subrecord from parent's list
  1. ;In: P = page number
  1. ; B = block number
  1. ; PDA = parent IENS
  1. ; IENS = IENS of record to remove
  1. N R,S
  1. ;
  1. S S=$G(@DDSREFT@(P,B,PDA,"B",IENS)) Q:'S
  1. K @DDSREFT@(P,B,PDA,"B",IENS)
  1. ;
  1. F S=S:1 Q:$D(@DDSREFT@(P,B,PDA,S+1))[0 D
  1. . S R=@DDSREFT@(P,B,PDA,S+1)
  1. . S @DDSREFT@(P,B,PDA,S)=R
  1. . S @DDSREFT@(P,B,PDA,"B",R)=S
  1. K @DDSREFT@(P,B,PDA,S)
  1. Q
  1. ;
  1. DEL ;Delete (sub)records added between saves
  1. ;(user quit without saving)
  1. N DA,DIK
  1. S DDSI=0
  1. F S DDSI=$O(@DDSREFT@("ADD",DDSI)) Q:'DDSI D
  1. . K DA
  1. . S DA=$P(@DDSREFT@("ADD",DDSI),U),DIK=U_$P(^(DDSI),U,2)
  1. . F DDSX=2:1:$L(DA,",")-1 S DA(DDSX-1)=$P(DA,",",DDSX)
  1. . S DA=+DA
  1. . D ^DIK
  1. K DDSI,DDSX
  1. Q
  1. ;#8078 record
  1. ;#8079 subrecord
  1. ;#8080 WARNING: DELETIONS ARE DONE...
  1. ;#9038 Enter 'Y' to delete...