source: FOIAVistA/tag/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGADTP3.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.1 KB
Line 
1RGADTP3 ;BIR/CMC-RGADTP2 - CONTINUED ;10/30/02 10:04
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**48**;30 Apr 99;Build 3
3 ;
4 ;MOVED CHKPVT AND DIFF FROM RGADTP2 DUE TO ROUTINE SIZE ISSUE
5 Q
6CHKPVT(ARRAY) ;CHECKS TO SEE IF OUTSTANDING IDENTITY EDIT IS WAITING TO BE SENT IN THE ADT/HL7 PIVOT FILE
7 ;**44 CREATED - ARRAY CONTAINS THE ARRAY ELEMENTS NEEDED TO FIND THE PATIENT IN THE ADT/HL7 PIVOT FILE
8 ;RETURNED IS -1^EDIT PENDING IN PIVOT FILE OR 0 IF THERE ISN'T ONE
9 I '$D(^VAT(391.71,"C",ARRAY("DFN"))) Q 0
10 N PIV,FIELDS
11 S PIV=$O(^VAT(391.71,"C",ARRAY("DFN"),"A"),-1) ;get last entry in the pivot file for this patient
12 I '$D(^VAT(391.71,"AXMIT",4,PIV))&('$D(^VAT(391.71,"AXMIT",3,PIV))) Q 0
13 S FIELDS=$$GET1^DIQ(391.71,PIV_",",2.1,"I")
14 I FIELDS[".01;"!(FIELDS[".02;")!(FIELDS[".03;")!(FIELDS[".09;")!(FIELDS[".0906;")!(FIELDS[".2403;")!(FIELDS["994;") Q "-1^DFN "_ARRAY("DFN")_": Edits made to identity fields waiting to come to MPI, MPI update not processed as of yet."
15 Q 0
16 ;
17DIFF(ARRAY,RGRSDFN,DR,ARAY) ; are there fields to update? **47
18 N NAME,SSN,PDOB,SEX,MMN,OLDNAME,OLDHLNAM,OLDMMN,OLDHLMMN,HLNAME,HLMMN,SSNV,MBI,PSNR
19 S DR="",NAME=$$GET1^DIQ(2,+RGRSDFN_",",.01,"I"),HLNAME=ARRAY("NAME")
20 ;**48 remove name standardization check
21 ;D STDNAME^XLFNAME(.NAME,"F",.OLDNAME) S HLNAME=ARRAY("NAME") D STDNAME^XLFNAME(.HLNAME,"F",.OLDHLNAM)
22 I NAME'=$G(HLNAME) S DR=DR_".01;",ARAY(2,.01)=ARRAY("NAME")
23 S PDOB=$$GET1^DIQ(2,+RGRSDFN_",",.03,"I") I PDOB'=ARRAY("MPIDOB") S DR=DR_".03;",ARAY(2,.03)=ARRAY("MPIDOB")
24 S SSN=$$GET1^DIQ(2,+RGRSDFN_",",.09,"I") D
25 .I SSN["P",ARRAY("SSN")=""!(ARRAY("SSN")="@") Q
26 .; ^ treat pseudos and null/@ as the same
27 .; **47 if incoming SSN value is null/@ and existing SSN isn't a pseudo create a new pseudo SSN
28 .I SSN'["P" I ARRAY("SSN")="@"!(ARRAY("SSN")="") S ARRAY("SSN")="P"
29 .I SSN'=ARRAY("SSN"),ARRAY("SSN")'="" S DR=DR_".09;",ARAY(2,.09)=ARRAY("SSN")
30 S SEX=$$GET1^DIQ(2,+RGRSDFN_",",.02,"I") D
31 .I SEX=""&(ARRAY("SEX")="@") Q
32 .; ^ treat null and @ as same
33 .I SEX'=ARRAY("SEX") S DR=DR_".02;",ARAY(2,.02)=ARRAY("SEX")
34 S SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I") I SSNV="" S SSNV="@"
35 ;if SSN VERIFICATION STATUS field has been added to the DD then attempt to set it
36 N ERROR,LABEL D FIELD^DID(2,.0907,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
37 .I SSNV'=ARRAY(.0907) S ARAY(2,.0907)=$G(ARRAY(.0907)),DR=DR_".0907;"
38 S PSNR=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I") I PSNR="" S PSNR="@"
39 ;if Pseudo SSN Reason field has been added to the DD then attempt to set it
40 N ERROR,LABEL D FIELD^DID(2,.0906,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
41 .I PSNR'=ARRAY(.0906) S ARAY(2,.0906)=$G(ARRAY(.0906)),DR=DR_".0906;"
42 S MBI=$$GET1^DIQ(2,+RGRSDFN_",",994,"I") I MBI="" S MBI="@"
43 I MBI="@"&(ARRAY("MBI")="") Q
44 ; ^ treat @ and null as the same
45 I MBI'=ARRAY("MBI") S DR=DR_"994;",ARAY(2,994)=ARRAY("MBI")
46 S MMN=$$GET1^DIQ(2,+RGRSDFN_",",.2403,"I") I MMN="" S MMN="@"
47 D STDNAME^XLFNAME(.MMN,"F",.OLDMMN) S HLMMN=ARRAY("MMN") D STDNAME^XLFNAME(.HLMMN,"F",.OLDHLMMN)
48 I MMN="@"&($G(HLMMN)="") Q
49 ; ^ treat @ and null as same
50 I MMN'=$G(HLMMN) S DR=DR_".2403;",ARAY(2,.2403)=ARRAY("MMN")
51 I $D(ARRAY("ALIAS")) S DR=DR_"1;"
52 Q
Note: See TracBrowser for help on using the repository browser.