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

DIEF1.m

Go to the documentation of this file.
  1. DIEF1 ;SFISC/DPC-FILER UTILITIES ;22MAR2006
  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. LOAD(DIEFF,DIEFDAS,DIEFFLD,DIEFFLG,DIEFVAL,DIEFAR,DIEFOUT) ;
  1. LOADX ;
  1. N DIEFIEN
  1. I '$D(DIQUIET) N DIQUIET S DIQUIET=1
  1. I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
  1. I $G(DIEFDAS)']"" D BLD^DIALOG(202,"IENS","IENS") G OUT
  1. I $E(DIEFDAS,$L(DIEFDAS))="," S DIEFIEN=DIEFDAS
  1. E S DIEFIEN=$$IEN^DIEFU(.DIEFDAS)
  1. I '$$VROOT^DIEFU(DIEFAR) G OUT
  1. I '$$VFILE^DIEFU(DIEFF,"D") G OUT
  1. S DIEFFLD=$$CHKFLD^DIEFU(DIEFF,DIEFFLD) G:'DIEFFLD OUT
  1. I $G(DIEFFLG)["R",'$$VENTRY^DIEFU(DIEFF,DIEFIEN,"D") G OUT
  1. S @DIEFAR@(DIEFF,DIEFIEN,DIEFFLD)=DIEFVAL
  1. OUT I $G(DIEFOUT)]"" D CALLOUT^DIEFU(DIEFOUT)
  1. Q
  1. ;
  1. FLDNUM(DIEFF,DIEFFDNM) ;
  1. FLDNUMX ;
  1. I '$D(DIQUIET) N DIQUIET S DIQUIET=1
  1. I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
  1. I '$$VFILE^DIEFU(DIEFF,"D") Q 0
  1. N DIEFFNUM
  1. I $D(^DD(DIEFF,"B",DIEFFDNM)) D Q DIEFFNUM
  1. . S DIEFFNUM=$O(^DD(DIEFF,"B",DIEFFDNM,""))
  1. . I $O(^DD(DIEFF,"B",DIEFFDNM,DIEFFNUM)) N P S P(1)=DIEFFDNM,P("FILE")=DIEFF D BLD^DIALOG(505,.P,.P) S DIEFFNUM=0
  1. N P S P("FILE")=DIEFF,P(1)=DIEFFDNM D BLD^DIALOG(501,.P,.P)
  1. Q 0
  1. ;
  1. ADDCONV(DIEFIEN,DIEFADAR) ;
  1. N I,DIEFNIEN,P
  1. F I=1:1:$L(DIEFIEN,",")-1 D
  1. . S P=$P(DIEFIEN,",",I)
  1. . I P,$E(P)'="+" Q
  1. . S DIEFNIEN=@DIEFADAR@($TR(P,"+?"))
  1. . S $P(DIEFIEN,",",I)=DIEFNIEN
  1. Q DIEFIEN
  1. ;
  1. PUTDATA ;CODE TO ACTUALLY PUT THE DATA INTO THE NODE BEING EDITED. ALSO SAVES ORIGINAL VALUES. CALLED FROM DIEF.
  1. I +DIEFSPOT D
  1. . I DIEFNVAL[U D Q
  1. . . S DIEFNG=1
  1. . . N INT,EXT
  1. . . S INT(1)=$$FLDNM^DIEFU(DIEFF,DIEFFLD),INT(2)=$$FILENM^DIEFU(DIEFF),EXT("FILE")=DIEFF,EXT("FIELD")=DIEFFLD
  1. . . D BLD^DIALOG(714,.INT,.EXT)
  1. . S DIEFOVAL=$P(DIEFFVAL,"^",DIEFSPOT)
  1. . S $P(DIEFFVAL,"^",DIEFSPOT)=DIEFNVAL,DOREPL=1
  1. E I $E(DIEFSPOT)="E" D
  1. . N FR,TO,OLEN,NLEN
  1. . S FR=$P($P(DIEFSPOT,"E",2),",",1),TO=$P(DIEFSPOT,",",2)
  1. . S NLEN=$L(DIEFNVAL)
  1. . I NLEN-1>(TO-FR) D Q
  1. . . S DIEFNG=1
  1. . . N INT,EXT
  1. . . S INT(1)=$$FLDNM^DIEFU(DIEFF,DIEFFLD),INT(2)=$$FILENM^DIEFU(DIEFF),EXT("FILE")=DIEFF,EXT("FIELD")=DIEFFLD
  1. . . D BLD^DIALOG(716,.INT,.EXT)
  1. . S DIEFOVAL=$E(DIEFFVAL,FR,TO),OLEN=$L(DIEFOVAL)
  1. . I $E(DIEFFVAL,TO+1,999)="" S $E(DIEFFVAL,FR,TO)=DIEFNVAL
  1. . E S $E(DIEFFVAL,FR,TO)=DIEFNVAL_$J("",$S(OLEN>NLEN:OLEN-NLEN,1:0))
  1. . S DOREPL=1
  1. E I DIEFSPOT=0 D
  1. . I $P($G(^DD(+$P(^DD(DIEFF,DIEFFLD,0),U,2),.01,0)),U,2)["W" D
  1. . . I '$$VROOT^DIEFU(DIEFNVAL) Q
  1. . . D PUTWP^DIEFW(DIEFFLAG,DIEFNVAL,DIEFNODE)
  1. . E D
  1. . . N INT,EXT
  1. . . S (INT(1),EXT(1))="MULTIPLE",EXT("FILE")=DIEFF,EXT("FIELD")=DIEFFLD
  1. . . D BLD^DIALOG(520,.INT,.EXT)
  1. . . S DIEFNG=1
  1. E I DIEFSPOT=" " D
  1. . N INT,EXT
  1. . S (INT(1),EXT(1))="COMPUTED",EXT("FILE")=DIEFF,EXT("FIELD")=DIEFFLD
  1. . D BLD^DIALOG(520,.INT,.EXT)
  1. . S DIEFNG=1
  1. Q
  1. ;
  1. LOCK ;
  1. S (DIEFNOLK,DIEFLCKS)=0,DIEFF=""
  1. F S DIEFF=$O(@DIEFAR@(DIEFF)) Q:DIEFF="" D Q:DIEFNOLK
  1. . I '$$VFILE^DIEFU(DIEFF,"D") S DIEFNOLK=1 Q
  1. . S DIEFFREF=$$FROOTDA^DIKCU(DIEFF,"D",.DIEFLEV) Q:DIEFFREF=""
  1. . S DIEFDAS=""
  1. . F S DIEFDAS=$O(@DIEFAR@(DIEFF,DIEFDAS)) Q:DIEFDAS="" D Q:DIEFNOLK
  1. . . N DA
  1. . . I '$$GOODIEN^DIEF(DIEFF,DIEFDAS,DIEFLEV,.DA,"D") S DIEFNOLK=1 Q
  1. . . S DIEFLCKS=DIEFLCKS+1
  1. . . S DIEFLOCK(DIEFLCKS)=$NA(@DIEFFREF@(DA))
  1. . . D LOCK^DILF(DIEFLOCK(DIEFLCKS)) E D ;**147
  1. . . . S DIEFNOLK=1
  1. . . . N E S E("FILE")=DIEFF,E("IENS")=DIEFDAS D BLD^DIALOG(110,"",.E)
  1. Q
  1. UNLOCK ;
  1. N I
  1. F I=1:1:DIEFLCKS L -@DIEFLOCK(I)
  1. Q
  1. ;
  1. RESTORE(DIKEY,DIEFTMP) ;Restore key fields to pre-edited values
  1. ;DIKEY(rFile#,key#,iens) = "" : if key is not unique
  1. ; = n : if key fields not assigned a value
  1. ;DIKEY(rFile#,key#,iens,file,field) = levdiff : set if field not
  1. ; assigned a value
  1. N DIEFDA,DIEKK,DIRFIL,DIFIL,DIFLD,DIFLDI,DIIENS,DIIENSA,DIOLD,DILEVD
  1. K DIEFDA
  1. ;
  1. ;Loop through root files and keys in DIKEY
  1. S DIRFIL=0 F S DIRFIL=$O(DIKEY(DIRFIL)) Q:'DIRFIL D
  1. . S DIEKK=0 F S DIEKK=$O(DIKEY(DIRFIL,DIEKK)) Q:'DIEKK D
  1. .. Q:$D(^DD("KEY",DIEKK,0))[0
  1. .. ;
  1. .. ;Get fields in key
  1. .. K DIFLD
  1. .. S DIFLDI=0 F S DIFLDI=$O(^DD("KEY",DIEKK,2,DIFLDI)) Q:'DIFLDI D
  1. ... S DIFLD=$P($G(^DD("KEY",DIEKK,2,DIFLDI,0)),U),DIFIL=$P($G(^(0)),U,2)
  1. ... Q:'DIFLD!'DIFIL
  1. ... S DIFLD(DIFIL,DIFLD)=""
  1. .. ;
  1. .. ;Loop through records in DIKEY
  1. .. S DIIENS=" " S DIIENS=$O(DIKEY(DIRFIL,DIEKK,DIIENS)) Q:DIIENS="" D
  1. ... ;
  1. ... ;Generate error if key is not unique
  1. ... D:DIKEY(DIRFIL,DIEKK,DIIENS)="" ERR740^DIEVK1(DIRFIL,DIEKK,DIIENS)
  1. ... ;
  1. ... ;Loop through files/fields in key
  1. ... S DIFIL=0 F S DIFIL=$O(DIFLD(DIFIL)) Q:'DIFIL D
  1. .... S DIFLD=0 F S DIFLD=$O(DIFLD(DIFIL,DIFLD)) Q:'DIFLD D
  1. ..... Q:$D(^DD(DIFIL,DIFLD,0))[0
  1. ..... ;
  1. ..... ;Generate error if key field not assigned a value
  1. ..... I $D(DIKEY(DIRFIL,DIEKK,DIIENS,DIFIL,DIFLD))#2 D
  1. ...... S (DILEVD,DIFLD(DIFIL,DIFLD))=+DIKEY(DIRFIL,DIEKK,DIIENS,DIFIL,DIFLD)
  1. ...... D ERR744^DIEVK1(DIFIL,DIFLD,DIEKK,$P(DIIENS,",",DILEVD+1,999))
  1. ..... ;
  1. ..... ;Set the FDA to restore the field to original value
  1. ..... S DILEVD=DIFLD(DIFIL,DIFLD)
  1. ..... S:DILEVD="" (DILEVD,DIFLD(DIFIL,DIFLD))=$$FLEVDIFF^DIKCU(DIRFIL,DIFIL)
  1. ..... S DIIENSA=$P(DIIENS,",",DILEVD+1,999)
  1. ..... Q:$D(@DIEFTMP@("V",DIFIL,DIIENSA,DIFLD,"O"))[0 S DIOLD=^("O")
  1. ..... S DIEFDA(DIFIL,DIIENS,DIFLD)=DIOLD
  1. ;
  1. D:$D(DIEFDA) FILE^DIEF("U","DIEFDA")
  1. Q
  1. ;
  1. SKEYCHK(DIEFF,DIEFFLD,DIEFNVAL,DA,DIEFIEN,DIEFFXR) ;Check simple key
  1. N DIEFKEY,DIEFK,DIEFKCHK
  1. Q:'$D(^DD("KEY","F",DIEFF,DIEFFLD)) 1
  1. I DIEFNVAL="" D NKEY(DIEFF,DIEFFLD,DIEFIEN) Q 0
  1. Q:'$D(DIEFFXR) 1
  1. S @DIEFTMP@("V",DIEFF,DIEFIEN,DIEFFLD,"N")=DIEFNVAL
  1. S DIEFKCHK=$$KEYCHK^DIKK2(DIEFF,.DA,DIEFFLD,"DIEFFXR",DIEFIEN,"DIEFKEY","N")
  1. K @DIEFTMP@("V",DIEFF,DIEFIEN,DIEFFLD,"N")
  1. Q:DIEFKCHK 1
  1. S DIEFK=0 F S DIEFK=$O(DIEFKEY(DIEFF,DIEFIEN,"K",DIEFK)) Q:'DIEFK D ERR740^DIEVK1(DIEFF,DIEFK,DIEFIEN)
  1. Q 0
  1. ;
  1. NKEY(DIEFF,DIEFFLD,DIEFIEN) ;Generate error message #742
  1. N DIEFK
  1. S DIEFK=0 F S DIEFK=$O(^DD("KEY","F",DIEFF,DIEFFLD,DIEFK)) Q:'DIEFK D
  1. . S DIEFK(DIEFK)=""
  1. S DIEFK=0 F S DIEFK=$O(DIEFK(DIEFK)) Q:'DIEFK D ERR742^DIEVK1(DIEFF,DIEFFLD,DIEFK,DIEFIEN)
  1. Q