source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFCPTED.m@ 1093

Last change on this file since 1093 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.3 KB
Line 
1VAFCPTED ;ISA/RJS,Zoltan-EDIT EXISTING PATIENT ;04/06/99
2 ;;5.3;Registration;**149,333,756**;Aug 13, 1993;Build 5
3EDIT(DGDFN,ARRAY,STRNGDR) ;-- Edits existing patient
4 ;Input:
5 ; DGDFN - IEN in the PATIENT (#2) file
6 ; ARRAY - Array containing fields to be edited.
7 ; Ex. ARRAY(.111)="123 STREET" or ARRAY(2,.111)="123...
8 ; STRNGDR - String of delimited PATIENT (#2) file fields in the order
9 ; in which the fields will be processed by DIE.
10 ; Ex. ".01;.03;.05..."
11 ;Output:
12 ; No output
13 ;
14 S U="^"
15 N LOCKFLE,FLD,ZTQUEUED,DIQUIET,OLDZIP,VAFCX,STRNG
16 S (ZTQUEUED,DIQUIET)=1
17 L +^DPT(DGDFN):60
18 S LOCKFLE=$T ; Need to remember whether the lock went through.
19 I $L($G(@ARRAY@(.1112)))=5 D
20 . ; This section prevents a 5-digit ZIP from replacing
21 . ; an otherwise equivalent ZIP+4.
22 . S OLDZIP=$$GET1^DIQ(2,DGDFN_",",.1112,"I")
23 . I $E(OLDZIP,1,5)=@ARRAY@(.1112) S @ARRAY@(.1112)=OLDZIP
24 ;process the given PATIENT file DR string in the given order
25 S STRNG=STRNGDR F VAFCX=1:1 Q:STRNG="" S FLD=$P(STRNGDR,";",VAFCX) S STRNG=$P(STRNGDR,";",VAFCX+1,$L(STRNGDR,";")) D LOAD
26 ;
27 ;Do Address Bulletin if incoming Address does not equal existing
28 ;Address - removed bulletin with patch DG*5.3*333
29 ;
30 ;I $D(@ARRAY@(.111))!$D(@ARRAY@(.112))!$D(@ARRAY@(.113))!$D(@ARRAY@(.114))!$D(@ARRAY@(.115))!$D(@ARRAY@(.117))!$D(@ARRAY@(.1112)) D ;**333
31 ;. 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)))
32 ;
33 I LOCKFLE L -^DPT(DGDFN)
34 ;
35 K DIE,DA
36 Q
37 ;
38LOAD ; -- Loads fields to patient file
39 N DR,DIE
40 ;**756 check if updating ALIAS
41 I FLD=1 D ALIAS Q
42 S DA=DGDFN,DIE="^DPT("
43 I $G(@ARRAY@(FLD))="" Q
44 I $G(@ARRAY@(FLD))["@" S @ARRAY@(FLD)="@"
45 ;GENERATE BULLETIN FOR CONDITION BELOW ?
46 I $G(@ARRAY@(FLD))[U Q
47 S DR=FLD_"///^S X=$G(@ARRAY@(FLD))"
48 D ^DIE
49 Q
50 ;
51ALIAS ; update Alias multiple **756
52 ;allow the synchronizing of the Alias multiple with the data passed in the array
53 ;array(1,x)=name (last, first middle suffix format)^ssn
54 N HAVE,I,MIEN,ADD,DONE,FDA,MPIFERR,DEL,ALIAS,CNT
55 M HAVE=^DPT(DGDFN,.01)
56 S CNT=0
57 ;see if any need to be added
58 S I=0 F S I=$O(@ARRAY@(1,I)) Q:'I D ;loop through incoming data
59 . S ADD=1,(DONE,MIEN)=0 F S MIEN=$O(HAVE(MIEN)) Q:'MIEN D I DONE Q ;loop through existing data
60 ..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
61 .I ADD S ALIAS=@ARRAY@(1,I) D ;add new entry to subfile
62 ..S FDA(2.01,"+"_I_","_DGDFN_",",.01)=$P(@ARRAY@(1,I),"^")
63 ..S FDA(2.01,"+"_I_","_DGDFN_",",1)=$P(@ARRAY@(1,I),"^",2)
64 I $D(FDA) D UPDATE^DIE("E","FDA",,"MPIFERR") I $G(MPIFERR("DIERR",1,"TEXT",1))'="" S RGER="-1^"_MPIFERR("DIERR",1,"TEXT",1)
65 ;delete entries
66 K FDA,MPIFERR
67 S MIEN=0 F S MIEN=$O(HAVE(MIEN)) Q:'MIEN D ;loop through existing data
68 . S DEL=1,(DONE,I)=0 F S I=$O(@ARRAY@(1,I)) Q:'I D I DONE Q ;loop through incoming data
69 . . 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
70 . I DEL S FDA(2.01,MIEN_","_DGDFN_",",.01)="@" ;existing entry to delete
71 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
72 Q
Note: See TracBrowser for help on using the repository browser.