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

VAFCPTED.m

Go to the documentation of this file. 
  1. VAFCPTED ;ISA/RJS,Zoltan-EDIT EXISTING PATIENT ;04/06/99
  1.  ;;5.3;Registration;**149,333,756,1015**;Aug 13, 1993;Build 21
  1. EDIT(DGDFN,ARRAY,STRNGDR) ;-- Edits existing patient
  1.  ;Input:
  1.  ;  DGDFN - IEN in the PATIENT (#2) file
  1.  ;  ARRAY - Array containing fields to be edited.
  1.  ;          Ex. ARRAY(.111)="123 STREET" or ARRAY(2,.111)="123...
  1.  ;  STRNGDR - String of delimited PATIENT (#2) file fields in the order 
  1.  ;            in which the fields will be processed by DIE.
  1.  ;            Ex. ".01;.03;.05..."
  1.  ;Output:
  1.  ;  No output
  1.  ;
  1.  S U="^"
  1.  N LOCKFLE,FLD,ZTQUEUED,DIQUIET,OLDZIP,VAFCX,STRNG
  1.  S (ZTQUEUED,DIQUIET)=1
  1.  L +^DPT(DGDFN):60
  1.  S LOCKFLE=$T ; Need to remember whether the lock went through.
  1.  I $L($G(@ARRAY@(.1112)))=5 D
  1.  . ; This section prevents a 5-digit ZIP from replacing
  1.  . ; an otherwise equivalent ZIP+4.
  1.  . S OLDZIP=$$GET1^DIQ(2,DGDFN_",",.1112,"I")
  1.  . I $E(OLDZIP,1,5)=@ARRAY@(.1112) S @ARRAY@(.1112)=OLDZIP
  1.  ;process the given PATIENT file DR string in the given order
  1.  S STRNG=STRNGDR F VAFCX=1:1 Q:STRNG=""  S FLD=$P(STRNGDR,";",VAFCX) S STRNG=$P(STRNGDR,";",VAFCX+1,$L(STRNGDR,";")) D LOAD
  1.  ;
  1.  ;Do Address Bulletin if incoming Address does not equal existing
  1.  ;Address - removed bulletin with patch DG*5.3*333
  1.  ;
  1.  ;I $D(@ARRAY@(.111))!$D(@ARRAY@(.112))!$D(@ARRAY@(.113))!$D(@ARRAY@(.114))!$D(@ARRAY@(.115))!$D(@ARRAY@(.117))!$D(@ARRAY@(.1112)) D  ;**333
  1.  ;. 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)))
  1.  ;
  1.  I LOCKFLE L -^DPT(DGDFN)
  1.  ;
  1.  K DIE,DA
  1.  Q
  1.  ;
  1. LOAD ; -- Loads fields to patient file
  1.  N DR,DIE
  1.  ;**756 check if updating ALIAS
  1.  I FLD=1 D ALIAS Q
  1.  S DA=DGDFN,DIE="^DPT("
  1.  I $G(@ARRAY@(FLD))="" Q
  1.  I $G(@ARRAY@(FLD))["@" S @ARRAY@(FLD)="@"
  1.  ;GENERATE BULLETIN FOR CONDITION BELOW ?
  1.  I $G(@ARRAY@(FLD))[U Q
  1.  S DR=FLD_"///^S X=$G(@ARRAY@(FLD))"
  1.  D ^DIE
  1.  Q
  1.  ;
  1. ALIAS ; update Alias multiple **756
  1.  ;allow the synchronizing of the Alias multiple with the data passed in the array
  1.  ;array(1,x)=name (last, first middle suffix format)^ssn
  1.  N HAVE,I,MIEN,ADD,DONE,FDA,MPIFERR,DEL,ALIAS,CNT
  1.  M HAVE=^DPT(DGDFN,.01)
  1.  S CNT=0
  1.  ;see if any need to be added
  1.  S I=0 F  S I=$O(@ARRAY@(1,I)) Q:'I  D  ;loop through incoming data
  1.  . S ADD=1,(DONE,MIEN)=0 F  S MIEN=$O(HAVE(MIEN)) Q:'MIEN  D  I DONE Q  ;loop through existing data
  1.  ..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
  1.  .I ADD S ALIAS=@ARRAY@(1,I) D  ;add new entry to subfile
  1.  ..S FDA(2.01,"+"_I_","_DGDFN_",",.01)=$P(@ARRAY@(1,I),"^")
  1.  ..S FDA(2.01,"+"_I_","_DGDFN_",",1)=$P(@ARRAY@(1,I),"^",2)
  1.  I $D(FDA) D UPDATE^DIE("E","FDA",,"MPIFERR") I $G(MPIFERR("DIERR",1,"TEXT",1))'="" S RGER="-1^"_MPIFERR("DIERR",1,"TEXT",1)
  1.  ;delete entries
  1.  K FDA,MPIFERR
  1.  S MIEN=0 F  S MIEN=$O(HAVE(MIEN)) Q:'MIEN  D  ;loop through existing data
  1.  . S DEL=1,(DONE,I)=0 F  S I=$O(@ARRAY@(1,I)) Q:'I  D  I DONE Q  ;loop through incoming data
  1.  . . 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
  1.  . I DEL S FDA(2.01,MIEN_","_DGDFN_",",.01)="@" ;existing entry to delete
  1.  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
  1.  Q