freem_fileman/USER/DDS6.m - view

File: [Coherent Logic Development] / freem_fileman / USER / DDS6.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD

Restructure repository

1: DDS6 ;SFISC/MKO-DELETIONS ;02:49 PM 9 Nov 1994 2: ;;21.0;VA FileMan;;Dec 28, 1994 3: ;Per VHA Directive 10-93-142, this routine should not be modified. 4: ;Enter here if user deleted record from the .01 of the (sub)record 5: ;(called from DDS01) 6: ;In: DDSU array, DDSOLD, DDSFLD 7: D D 8: I 'Y D 9: . S @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D")=DDSOLD 10: . S:$D(DDSU("X"))#2 @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"X")=DDSU("X") 11: E D 12: . I $D(DDSREP) D 13: .. D DEL^DDSM1(DDSDA) 14: . E D K I $D(DDSPTB) D 15: .. S DDACT="NB" 16: .. S $P(@DDSREFT@(DDSPG,DDSBK),U)="" 17: .. D DB^DDSR(DDSPG,DDSBK) 18: .. D RPF^DDS7 19: . E S DDACT="Q",DA="" 20: ; 21: I '$P(DDSSC(DDSSC),U,4),'$D(DDSREP) D 22: . D PG^DDSRSEL 23: . D:$G(DDSSEL) PUT^DDSVALF(1,1,$P(^DIST(.403,+DDS,21),U),"") 24: Q 25: ; 26: DM ;Enter here if user deleted record from the Select prompt 27: ;(called from DDS5) 28: ;In: DDSU array, DDSOLD, DDSFLD 29: ; 30: ;Get DA and DIE for subfile level and delete 31: D DDA^DDS5(DDSOLD,.DA,.DDSDL) 32: D 33: . N DIE,DDSDA 34: . S DIE=U_$P(DDSU("M"),U,2) 35: . S DDSDA=DA_"," F DDSI=1:1:DDSDL S DDSDA=DDSDA_DA(DDSI)_"," 36: . K DDSI 37: . D D 38: . D:Y K 39: ; 40: I 'Y D 41: . S @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D")=DDSOLD 42: . S:$D(DDSU("X"))#2 @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"X")=DDSU("X") 43: . D UDA^DDS5(.DA,.DDSDL) 44: E D 45: . D LST^DDS5(.DA,.DDSDL,DDP,DDSDA,DDSFLD) 46: . D UDA^DDS5(.DA,.DDSDL) 47: Q 48: ; 49: D ;Delete the subrecord 50: ;In: DA array, DIE, DDSDL; Out: Y=1 if successful 51: N DR,DDS6DA,DDSI 52: D:DDM CLRMSG^DDS 53: S DDM=1 54: ; 55: K DIR S DIR(0)="YO" 56: D BLD^DIALOG(8080,$$EZBLD^DIALOG(8078+(DDSDL>0)),"","DIR(""A"")") 57: D BLD^DIALOG(9038,"","","DIR(""?"")") 58: ; 59: S DIR0=IOSL-1_U_($L(DIR("A"))+1)_"^3^"_(IOSL-3)_"^0" 60: D ^DIR K DIR 61: D CLRMSG^DDS 62: I X=""!$D(DIRUT)!'Y S Y=0 K DIRUT,DUOUT,DIROUT,DTOUT Q 63: ; 64: S DDS6DA=DA N D0 65: F DDSI=1:1 Q:$D(DA(DDSI))[0 S DDS6DA(DDSI)=DA(DDSI) N @("D"_DDSI) 66: W $P(DDGLVID,DDGLDEL,9) S X=IOM X $G(^%ZOSF("RM")) 67: S DR=".01///@" D ^DIE K DI 68: W $P(DDGLVID,DDGLDEL,8) S X=0 X ^%ZOSF("RM") 69: ; 70: ;I $D(DA) H 2 W $P(DDGLCLR,DDGLDEL,2) D R^DDSR S Y=0 Q 71: I $D(DA) S:$Y>(DDSHBX+1) DDSKM=1,DDM=1 S Y=0 Q 72: ; 73: S Y=1,DA=DDS6DA 74: I '$G(DDSCHANG),$G(DDSPARM)["C" S DDSCHANG=1 75: F DDSI=1:1 Q:$D(DDS6DA(DDSI))[0 S DA(DDSI)=DDS6DA(DDSI) 76: Q 77: ; 78: K ;Remove all data pertaining to the (sub)record from DDSREFT 79: ;In: DDSDA, DIE at subfile level 80: ; 81: N B,P,FN,PAT,PDA 82: S PAT=".E1"""_DDSDA_"""" 83: S PDA=$P(DDSDA,",",2,999) 84: S P=0 85: F S P=$O(@DDSREFT@(P)) Q:'P D 86: . S B=0 F S B=$O(@DDSREFT@(P,B)) Q:'B D 87: .. S FN="F"_$P(@DDSREFS@(P,B),U,3),DDS6DA=" " 88: .. F S DDS6DA=$O(@DDSREFT@(P,B,DDS6DA)) Q:'DDS6DA D 89: ... I DDS6DA?@PAT,$P(@DDSREFT@(P,B,DDS6DA,"GL"),DIE)="" D 90: .... K @DDSREFT@(P,B,DDS6DA) 91: .... K @DDSREFT@(FN,DDS6DA) 92: ... E I DDS6DA=PDA,DIE=@DDSREFT@(P,B,PDA,"GL") D DELP 93: K DDS6DA 94: Q 95: ; 96: DELP ;Delete subrecord from parent's list 97: N R,S 98: S S=$G(@DDSREFT@(P,B,PDA,"B",DDSDA)) Q:'S 99: K @DDSREFT@(P,B,PDA,"B",DDSDA) 100: ; 101: F S=S:1 Q:$D(@DDSREFT@(P,B,PDA,S+1))[0 D 102: . S R=@DDSREFT@(P,B,PDA,S+1) 103: . S @DDSREFT@(P,B,PDA,S)=R 104: . S @DDSREFT@(P,B,PDA,"B",R)=S 105: K @DDSREFT@(P,B,PDA,S) 106: Q 107: ; 108: DEL ;Delete (sub)records added between saves 109: ;(user quit without saving) 110: N DA,DIK 111: S DDSI=0 112: F S DDSI=$O(@DDSREFT@("ADD",DDSI)) Q:'DDSI D 113: . K DA 114: . S DA=$P(@DDSREFT@("ADD",DDSI),U),DIK=U_$P(^(DDSI),U,2) 115: . F DDSX=2:1:$L(DA,",")-1 S DA(DDSX-1)=$P(DA,",",DDSX) 116: . S DA=+DA 117: . D ^DIK 118: K DDSI,DDSX 119: Q 120: ;#8078 record 121: ;#8079 subrecord 122: ;#8080 WARNING: DELETIONS ARE DONE... 123: ;#9038 Enter 'Y' to delete...