VAFCPTED ;ISA/RJS,Zoltan-EDIT EXISTING PATIENT ;04/06/99
;;5.3;Registration;**149,333,756,1015**;Aug 13, 1993;Build 21
EDIT(DGDFN,ARRAY,STRNGDR) ;-- Edits existing patient
;Input:
; DGDFN - IEN in the PATIENT (#2) file
; ARRAY - Array containing fields to be edited.
; Ex. ARRAY(.111)="123 STREET" or ARRAY(2,.111)="123...
; STRNGDR - String of delimited PATIENT (#2) file fields in the order
; in which the fields will be processed by DIE.
; Ex. ".01;.03;.05..."
;Output:
; No output
;
S U="^"
N LOCKFLE,FLD,ZTQUEUED,DIQUIET,OLDZIP,VAFCX,STRNG
S (ZTQUEUED,DIQUIET)=1
L +^DPT(DGDFN):60
S LOCKFLE=$T ; Need to remember whether the lock went through.
I $L($G(@ARRAY@(.1112)))=5 D
. ; This section prevents a 5-digit ZIP from replacing
. ; an otherwise equivalent ZIP+4.
. S OLDZIP=$$GET1^DIQ(2,DGDFN_",",.1112,"I")
. I $E(OLDZIP,1,5)=@ARRAY@(.1112) S @ARRAY@(.1112)=OLDZIP
;process the given PATIENT file DR string in the given order
S STRNG=STRNGDR F VAFCX=1:1 Q:STRNG="" S FLD=$P(STRNGDR,";",VAFCX) S STRNG=$P(STRNGDR,";",VAFCX+1,$L(STRNGDR,";")) D LOAD
;
;Do Address Bulletin if incoming Address does not equal existing
;Address - removed bulletin with patch DG*5.3*333
;
;I $D(@ARRAY@(.111))!$D(@ARRAY@(.112))!$D(@ARRAY@(.113))!$D(@ARRAY@(.114))!$D(@ARRAY@(.115))!$D(@ARRAY@(.117))!$D(@ARRAY@(.1112)) D ;**333
;. D ADDRESS^RGRSBULL(DGDFN,$G(@ARRAY@(.01)),$G(@ARRAY@(.111)),$G(@ARRAY@(.112)),$G(@ARRAY@(.113)),@ARRAY@("SENDING SITE"),$G(@ARRAY@(.114)),$G(@ARRAY@(.117)),$G(@ARRAY@(.115)),$G(@ARRAY@(.1112)))
;
I LOCKFLE L -^DPT(DGDFN)
;
K DIE,DA
Q
;
LOAD ; -- Loads fields to patient file
N DR,DIE
;**756 check if updating ALIAS
I FLD=1 D ALIAS Q
S DA=DGDFN,DIE="^DPT("
I $G(@ARRAY@(FLD))="" Q
I $G(@ARRAY@(FLD))["@" S @ARRAY@(FLD)="@"
;GENERATE BULLETIN FOR CONDITION BELOW ?
I $G(@ARRAY@(FLD))[U Q
S DR=FLD_"///^S X=$G(@ARRAY@(FLD))"
D ^DIE
Q
;
ALIAS ; update Alias multiple **756
;allow the synchronizing of the Alias multiple with the data passed in the array
;array(1,x)=name (last, first middle suffix format)^ssn
N HAVE,I,MIEN,ADD,DONE,FDA,MPIFERR,DEL,ALIAS,CNT
M HAVE=^DPT(DGDFN,.01)
S CNT=0
;see if any need to be added
S I=0 F S I=$O(@ARRAY@(1,I)) Q:'I D ;loop through incoming data
. S ADD=1,(DONE,MIEN)=0 F S MIEN=$O(HAVE(MIEN)) Q:'MIEN D I DONE Q ;loop through existing data
..I $P(@ARRAY@(1,I),"^",1,2)=$P($G(HAVE(MIEN,0)),"^",1,2) S ADD=0,DONE=1 Q ;compare to existing data to see if already in subfile, if not then
.I ADD S ALIAS=@ARRAY@(1,I) D ;add new entry to subfile
..S FDA(2.01,"+"_I_","_DGDFN_",",.01)=$P(@ARRAY@(1,I),"^")
..S FDA(2.01,"+"_I_","_DGDFN_",",1)=$P(@ARRAY@(1,I),"^",2)
I $D(FDA) D UPDATE^DIE("E","FDA",,"MPIFERR") I $G(MPIFERR("DIERR",1,"TEXT",1))'="" S RGER="-1^"_MPIFERR("DIERR",1,"TEXT",1)
;delete entries
K FDA,MPIFERR
S MIEN=0 F S MIEN=$O(HAVE(MIEN)) Q:'MIEN D ;loop through existing data
. S DEL=1,(DONE,I)=0 F S I=$O(@ARRAY@(1,I)) Q:'I D I DONE Q ;loop through incoming data
. . I $P($G(HAVE(MIEN,0)),"^",1,2)=$P(@ARRAY@(1,I),"^",1,2) S DEL=0,DONE=1 Q ;compare to existing data to see if data should be deleted
. I DEL S FDA(2.01,MIEN_","_DGDFN_",",.01)="@" ;existing entry to delete
I $D(FDA) D FILE^DIE("E","FDA","MPIERR") I $G(MPIFERR("DIERR",1,"TEXT",1))'="" S RGER="-1^"_MPIFERR("DIERR",1,"TEXT",1) ;delete entry
Q
VAFCPTED ;ISA/RJS,Zoltan-EDIT EXISTING PATIENT ;04/06/99
+1 ;;5.3;Registration;**149,333,756,1015**;Aug 13, 1993;Build 21
EDIT(DGDFN,ARRAY,STRNGDR) ;-- Edits existing patient
+1 ;Input:
+2 ; DGDFN - IEN in the PATIENT (#2) file
+3 ; ARRAY - Array containing fields to be edited.
+4 ; Ex. ARRAY(.111)="123 STREET" or ARRAY(2,.111)="123...
+5 ; STRNGDR - String of delimited PATIENT (#2) file fields in the order
+6 ; in which the fields will be processed by DIE.
+7 ; Ex. ".01;.03;.05..."
+8 ;Output:
+9 ; No output
+10 ;
+11 SET U="^"
+12 NEW LOCKFLE,FLD,ZTQUEUED,DIQUIET,OLDZIP,VAFCX,STRNG
+13 SET (ZTQUEUED,DIQUIET)=1
+14 LOCK +^DPT(DGDFN):60
+15 ; Need to remember whether the lock went through.
SET LOCKFLE=$TEST
+16 IF $LENGTH($GET(@ARRAY@(.1112)))=5
Begin DoDot:1
+17 ; This section prevents a 5-digit ZIP from replacing
+18 ; an otherwise equivalent ZIP+4.
+19 SET OLDZIP=$$GET1^DIQ(2,DGDFN_",",.1112,"I")
+20 IF $EXTRACT(OLDZIP,1,5)=@ARRAY@(.1112)
SET @ARRAY@(.1112)=OLDZIP
End DoDot:1
+21 ;process the given PATIENT file DR string in the given order
+22 SET STRNG=STRNGDR
FOR VAFCX=1:1
IF STRNG=""
QUIT
SET FLD=$PIECE(STRNGDR,";",VAFCX)
SET STRNG=$PIECE(STRNGDR,";",VAFCX+1,$LENGTH(STRNGDR,";"))
DO LOAD
+23 ;
+24 ;Do Address Bulletin if incoming Address does not equal existing
+25 ;Address - removed bulletin with patch DG*5.3*333
+26 ;
+27 ;I $D(@ARRAY@(.111))!$D(@ARRAY@(.112))!$D(@ARRAY@(.113))!$D(@ARRAY@(.114))!$D(@ARRAY@(.115))!$D(@ARRAY@(.117))!$D(@ARRAY@(.1112)) D ;**333
+28 ;. D ADDRESS^RGRSBULL(DGDFN,$G(@ARRAY@(.01)),$G(@ARRAY@(.111)),$G(@ARRAY@(.112)),$G(@ARRAY@(.113)),@ARRAY@("SENDING SITE"),$G(@ARRAY@(.114)),$G(@ARRAY@(.117)),$G(@ARRAY@(.115)),$G(@ARRAY@(.1112)))
+29 ;
+30 IF LOCKFLE
LOCK -^DPT(DGDFN)
+31 ;
+32 KILL DIE,DA
+33 QUIT
+34 ;
LOAD ; -- Loads fields to patient file
+1 NEW DR,DIE
+2 ;**756 check if updating ALIAS
+3 IF FLD=1
DO ALIAS
QUIT
+4 SET DA=DGDFN
SET DIE="^DPT("
+5 IF $GET(@ARRAY@(FLD))=""
QUIT
+6 IF $GET(@ARRAY@(FLD))["@"
SET @ARRAY@(FLD)="@"
+7 ;GENERATE BULLETIN FOR CONDITION BELOW ?
+8 IF $GET(@ARRAY@(FLD))[U
QUIT
+9 SET DR=FLD_"///^S X=$G(@ARRAY@(FLD))"
+10 DO ^DIE
+11 QUIT
+12 ;
ALIAS ; update Alias multiple **756
+1 ;allow the synchronizing of the Alias multiple with the data passed in the array
+2 ;array(1,x)=name (last, first middle suffix format)^ssn
+3 NEW HAVE,I,MIEN,ADD,DONE,FDA,MPIFERR,DEL,ALIAS,CNT
+4 MERGE HAVE=^DPT(DGDFN,.01)
+5 SET CNT=0
+6 ;see if any need to be added
+7 ;loop through incoming data
SET I=0
FOR
SET I=$ORDER(@ARRAY@(1,I))
IF 'I
QUIT
Begin DoDot:1
+8 ;loop through existing data
SET ADD=1
SET (DONE,MIEN)=0
FOR
SET MIEN=$ORDER(HAVE(MIEN))
IF 'MIEN
QUIT
Begin DoDot:2
+9 ;compare to existing data to see if already in subfile, if not then
IF $PIECE(@ARRAY@(1,I),"^",1,2)=$PIECE($GET(HAVE(MIEN,0)),"^",1,2)
SET ADD=0
SET DONE=1
QUIT
End DoDot:2
IF DONE
QUIT
+10 ;add new entry to subfile
IF ADD
SET ALIAS=@ARRAY@(1,I)
Begin DoDot:2
+11 SET FDA(2.01,"+"_I_","_DGDFN_",",.01)=$PIECE(@ARRAY@(1,I),"^")
+12 SET FDA(2.01,"+"_I_","_DGDFN_",",1)=$PIECE(@ARRAY@(1,I),"^",2)
End DoDot:2
End DoDot:1
+13 IF $DATA(FDA)
DO UPDATE^DIE("E","FDA",,"MPIFERR")
IF $GET(MPIFERR("DIERR",1,"TEXT",1))'=""
SET RGER="-1^"_MPIFERR("DIERR",1,"TEXT",1)
+14 ;delete entries
+15 KILL FDA,MPIFERR
+16 ;loop through existing data
SET MIEN=0
FOR
SET MIEN=$ORDER(HAVE(MIEN))
IF 'MIEN
QUIT
Begin DoDot:1
+17 ;loop through incoming data
SET DEL=1
SET (DONE,I)=0
FOR
SET I=$ORDER(@ARRAY@(1,I))
IF 'I
QUIT
Begin DoDot:2
+18 ;compare to existing data to see if data should be deleted
IF $PIECE($GET(HAVE(MIEN,0)),"^",1,2)=$PIECE(@ARRAY@(1,I),"^",1,2)
SET DEL=0
SET DONE=1
QUIT
End DoDot:2
IF DONE
QUIT
+19 ;existing entry to delete
IF DEL
SET FDA(2.01,MIEN_","_DGDFN_",",.01)="@"
End DoDot:1
+20 ;delete entry
IF $DATA(FDA)
DO FILE^DIE("E","FDA","MPIERR")
IF $GET(MPIFERR("DIERR",1,"TEXT",1))'=""
SET RGER="-1^"_MPIFERR("DIERR",1,"TEXT",1)
+21 QUIT
