Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGADTP2.m

    r613 r623  
    1 RGADTP2 ;BIR/DLR-ADT PROCESSOR TO RETRIGGER A08 or A04 MESSAGES WITH AL/AL (COMMIT/APPLICATION) ACKNOWLEDGEMENTS - CONTINUED ;10/30/02  10:04
    2         ;;1.0;CLINICAL INFO RESOURCE NETWORK;**27,20,45,44,47,48,49,52**;30 Apr 99;Build 2
    3 DBIA    ;
    4         ;Reference to $$ADD^VAFCEHU1 supported by IA #2753
    5         ;Reference to EDIT^VAFCPTED supported by IA #2784
    6         Q
    7 PROCIN(ARRAY,RGLOCAL,RGER,DFN,HL)       ;
    8         N RGRSDFN,OTHSITE,NODE,ICN,CMORIEN,CMOR,CMORDISP,SENSTVTY,RMTDOD,LOCDOD,VAFCA,VAFCA08,HERE,BOGUS,ARAY,REP
    9         S REP=$E(HL("ECH"),2)
    10         S HERE=$P($$SITE^VASITE,"^",3)
    11         ;if sending site is your site quit
    12         Q:$G(ARRAY("MPISSITE"))=$G(HERE)
    13         S ARRAY(.097)=$P($$NOW^XLFDT,".")
    14         I $G(ARRAY("ICN"))'="" D
    15         .S RGRSDFN=$$GETDFN^MPIF001(+ARRAY("ICN")) I +RGRSDFN<1 S RGER=RGRSDFN_" ICN#"_$G(ARRAY("ICN")) Q  ;quit and return error msg
    16         .S OTHSITE=ARRAY("SENDING SITE") ;**40 REMOVED THE PLUS TO KEEP SUFFIX ON STATION# & CHANGED THE SITE TO BE SENDING SITE INSTEAD OF AUTHORITATIVE SOURCE
    17         I $G(RGRSDFN)="" S RGRSDFN=$G(DFN)
    18         I $G(RGRSDFN)="" S RGER="-1^DFN not defined"
    19         Q:$G(RGER)
    20         I $G(OTHSITE)="" S OTHSITE=""
    21         S NODE=$$MPINODE^MPIFAPI(RGRSDFN)
    22         S ICN=$P(NODE,"^")
    23         S CMORIEN=$P(NODE,"^",3)
    24         S CMOR=$$NS^XUAF4(CMORIEN)
    25         S CMORDISP=$P(CMOR,"^",1)
    26         S CMOR=$P(CMOR,"^",2)
    27         ;
    28         ;If patient is Sensitive at other site but not here send bulletin
    29         I $G(ARRAY("SENSITIVITY"))'="" S SENSTVTY=$G(ARRAY("SENSITIVITY")) D
    30         .N NAME S NAME=ARRAY("NAME")
    31         .I '$$SENSTIVE^RGRSENS(RGRSDFN),SENSTVTY D
    32         ..S ARAY("SSN")=ARRAY("SSN"),ARAY("SENDING SITE")=ARRAY("SENDING SITE")
    33         ..S ARAY("SENSITIVITY USER")=ARRAY("SENSITIVITY USER"),ARAY("SENSITIVITY DATE")=ARRAY("SENSITIVITY DATE")
    34         ..D SENSTIVE^RGRSBUL1(RGRSDFN,"ARAY",NAME)
    35         ;
    36         ;MPIC_772 - **52; Commented out Remote Date of Death Indicated section.
    37         ;If patient has DATE OF DEATH (DOD) at remote site send bulletin
    38         ;Ignore time if present with date.
    39         ;S RMTDOD=$G(ARRAY("MPIDOD")),RMTDOD=$P(RMTDOD,".")
    40         ;S DFN=RGRSDFN D DEM^VADPT
    41         ;S LOCDOD=$P($P(VADM(6),"^"),".")
    42         ;If there is a remote DOD but no local DOD  OR if remote DOD is different from local DOD, send bulletin
    43         ;I RMTDOD D
    44         ;.N NAME S NAME=ARRAY("NAME"),ARAY("SSN")=ARRAY("SSN"),ARAY("SENDING SITE")=ARRAY("SENDING SITE")
    45         ;.D RMTDOD^RGRSBUL1(RGRSDFN,"ARAY",NAME,RMTDOD,LOCDOD)
    46         ;K VADM
    47         ;
    48 NOTLOC  I 'RGLOCAL D
    49         .;if sending site is not the CMOR AND NOT THE MPI - log update into PDR if differences exist **45 ADDED MPI
    50         .I (OTHSITE)'=(CMOR)&(OTHSITE'="200M") D  Q
    51         ..S VAFCA=$P($$NOW^XLFDT,".")_"^"_$$NOW^XLFDT_"^"_$G(ARRAY("SENDING SITE"))_"^"_RGRSDFN
    52         ..S ARRAY(.01)=$$FREE^RGRSPARS(ARRAY("NAME")),ARRAY(.03)=$$FREE^RGRSPARS($G(ARRAY("MPIDOB")))
    53         ..S ARRAY(.09)=$$FREE^RGRSPARS($G(ARRAY("SSN"))),ARRAY(.02)=$$SEX^RGRSPARS($G(ARRAY("SEX")))
    54         ..S ARRAY(.2403)=$$FREE^RGRSPARS($G(ARRAY("MMN"))),ARRAY(991.01)=$P($G(ARRAY("ICN")),"V")
    55         ..N ARAY M ARAY(2)=ARRAY
    56         ..S VAFCA08=1  ;S BOGUS=$$ADD^VAFCEHU1(VAFCA,"ARAY") comment out by RG*1*49
    57         .;if sending site is the CMOR OR MPI - synchronize data **45 ADDED MPI AND SSNV TO UPDATED FIELDS
    58         .I (OTHSITE)=(CMOR)!(OTHSITE="200M") D
    59         ..;**44 is there an outstanding edit in the ADT/HL7 PIVOT file for this patient for an identity element
    60         ..S RGER=$$CHKPVT^RGADTP3(.ARRAY) Q:+RGER<0
    61         ..N DR,ARAY2 S RGER=""
    62         ..D DIFF^RGADTP3(.ARRAY,RGRSDFN,.DR,.ARRAY) ;**47
    63         ..I DR'="" D
    64         ...S VAFCA08=1,ARAY(2,.01)=ARRAY("NAME"),ARAY(2,.03)=$G(ARRAY("MPIDOB"))
    65         ...I ARRAY("SSN")'="" S ARAY(2,.09)=$G(ARRAY("SSN")) ;**45 only set SSN to update if it isn't null
    66         ...S ARAY(2,.02)=$G(ARRAY("SEX")),ARAY(2,.2403)=$G(ARRAY("MMN")),ARAY(2,994)=$G(ARRAY("MBI"))
    67         ...;**48 ONLY SET SSN VERIFICATION STATUS AND PSEUDO SSN REASON IF SSN UPDATE WAS SUCCESSFUL
    68         ...I $D(ARRAY("ALIAS")) M ARAY(2,1)=ARRAY("ALIAS") ;**48 ADD ALIAS TO MIX
    69         ...D EDIT^VAFCPTED(RGRSDFN,"ARAY(2)",DR)
    70         ...;check to see if edits were successful, if not set RGER="why it failed"
    71         ...N NAME,SSN,PDOB,SEX,MMN,OLDNAME,OLDHLNAM,OLDMMN,OLDHLMMN,HLNAME,HLMMN,SSNV,MBI
    72         ...S NAME=$$GET1^DIQ(2,+RGRSDFN_",",.01,"I"),PDOB=$$GET1^DIQ(2,+RGRSDFN_",",.03,"I")
    73         ...S SSN=$$GET1^DIQ(2,+RGRSDFN_",",.09,"I"),SEX=$$GET1^DIQ(2,+RGRSDFN_",",.02,"I")
    74         ...S MMN=$$GET1^DIQ(2,+RGRSDFN_",",.2403,"I"),MBI=$$GET1^DIQ(2,+RGRSDFN_",",994,"I")
    75         ...D STDNAME^XLFNAME(.NAME,"F",.OLDNAME) S HLNAME=ARRAY("NAME") D STDNAME^XLFNAME(.HLNAME,"F",.OLDHLNAM)
    76         ...I NAME'=$G(HLNAME) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"Name field failure"
    77         ...I PDOB'=$G(ARRAY("MPIDOB")) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"DOB field failure"
    78         ...;**48
    79         ...I SSN["P" D
    80         ....;if pseudo SSN reason field has been added to the DD then attempt to set it
    81         ....N PS,ERROR,LABEL D FIELD^DID(2,.0906,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
    82         .....S ARAY2(2,.0906)=$G(ARRAY(.0906)),DR=".0906;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
    83         .....S PS=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I")
    84         .....I PS=""&(ARAY2(2,.0906)="@") Q
    85         .....I PS'=ARAY2(2,.0906) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"Pseudo SSN Reason field failure"
    86         .....I PS=ARAY2(2,.0906) D
    87         ......K ARAY2 N ERROR,LABEL D FIELD^DID(2,.0907,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
    88         ......S ARAY2(2,.0907)=$G(ARRAY(.0907)),DR=".0907;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
    89         ......S SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I")
    90         ......S:$G(ARRAY(.0907))="@" ARRAY(.0907)="" I SSNV'=$G(ARRAY(.0907)) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SSN VERIFICATION field failure"
    91         ...I $G(ARRAY("SSN"))'="",SSN'=$G(ARRAY("SSN")) D
    92         ....I $G(ARRAY("SSN"))="P",SSN["P" Q  ;**47 NEEDED TO CREATE PSEUDO AND DID
    93         ....S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SSN field failure" ;**45 only check if SSN is sent isn't null
    94         ...I SSN=$G(ARRAY("SSN")) D
    95         ....;if SSN VERIFICATION STATUS field has been added to the DD then attempt to set it
    96         ....K ARAY2 N ERROR,LABEL D FIELD^DID(2,.0907,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
    97         .....S ARAY2(2,.0907)=$G(ARRAY(.0907)) S DR=".0907;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
    98         .....S SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I")
    99         .....S:$G(ARRAY(.0907))="@" ARRAY(.0907)="" I SSNV'=$G(ARRAY(.0907)) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SSN VERIFICATION field failure"
    100         .....I SSNV'="" D
    101         ......N PS,ERROR,LABEL D FIELD^DID(2,.0906,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
    102         ......S ARAY2(2,.0906)=$G(ARRAY(.0906)) S DR=".0906;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
    103         ......S PS=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I")
    104         ......I PS=""&(ARAY2(2,.0906)="@") Q
    105         ......S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"Pseudo SSN Reason field failure"
    106         ...I SEX'=$G(ARRAY("SEX")) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SEX field failure"
    107         ...D STDNAME^XLFNAME(.MMN,"F",.OLDMMN) S HLMMN=ARRAY("MMN") D STDNAME^XLFNAME(.HLMMN,"F",.OLDHLMMN)
    108         ...I MMN'=$G(HLMMN) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"MOTHER'S MAIDEN NAME field failure"
    109         ...;**REMOVED MBI FROM PATCH 45 PUT BACK IN **47
    110         ...I MBI'=$G(ARRAY("MBI")) D
    111         ....Q:MBI=""&($G(ARRAY("MBI"))="@")  ;**47 "" AND @ ARE THE SAME
    112         ....S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"MULTIPLE BIRTH INDICATOR field failure"
    113         ...;send the updated fields to the MPI to synch site with MPI
    114         ...I HL("ETN")'="A31" S ZTSAVE("DFN")="",ZTRTN="MPISYN^RGADTPC",ZTDESC="Sending Synchronized Patient Data to MPI...",ZTIO="RG QUEUE",ZTDTH=$H D ^%ZTLOAD
    115         ...;**45 ^ don't trigger A31 sync message if A31 was being processed-- ack to a31 will sync id elements on MPI
    116         Q
     1RGADTP2 ;BIR/DLR-ADT PROCESSOR TO RETRIGGER A08 or A04 MESSAGES WITH AL/AL (COMMIT/APPLICATION) ACKNOWLEDGEMENTS - CONTINUED ;10/30/02  10:04
     2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**27,20,45,44,47,48**;30 Apr 99;Build 3
     3DBIA ;
     4 ;Reference to $$ADD^VAFCEHU1 supported by IA #2753
     5 ;Reference to EDIT^VAFCPTED supported by IA #2784
     6 Q
     7PROCIN(ARRAY,RGLOCAL,RGER,DFN,HL) ;
     8 N RGRSDFN,OTHSITE,NODE,ICN,CMORIEN,CMOR,CMORDISP,SENSTVTY,RMTDOD,LOCDOD,VAFCA,VAFCA08,HERE,BOGUS,ARAY,REP
     9 S REP=$E(HL("ECH"),2)
     10 S HERE=$P($$SITE^VASITE,"^",3)
     11 ;if sending site is your site quit
     12 Q:$G(ARRAY("MPISSITE"))=$G(HERE)
     13 S ARRAY(.097)=$P($$NOW^XLFDT,".")
     14 I $G(ARRAY("ICN"))'="" D
     15 .S RGRSDFN=$$GETDFN^MPIF001(+ARRAY("ICN")) I +RGRSDFN<1 S RGER=RGRSDFN_" ICN#"_$G(ARRAY("ICN")) Q  ;quit and return error msg
     16 .S OTHSITE=ARRAY("SENDING SITE") ;**40 REMOVED THE PLUS TO KEEP SUFFIX ON STATION# & CHANGED THE SITE TO BE SENDING SITE INSTEAD OF AUTHORITATIVE SOURCE
     17 I $G(RGRSDFN)="" S RGRSDFN=$G(DFN)
     18 I $G(RGRSDFN)="" S RGER="-1^DFN not defined"
     19 Q:$G(RGER)
     20 I $G(OTHSITE)="" S OTHSITE=""
     21 S NODE=$$MPINODE^MPIFAPI(RGRSDFN)
     22 S ICN=$P(NODE,"^")
     23 S CMORIEN=$P(NODE,"^",3)
     24 S CMOR=$$NS^XUAF4(CMORIEN)
     25 S CMORDISP=$P(CMOR,"^",1)
     26 S CMOR=$P(CMOR,"^",2)
     27 ;
     28 ;If patient is Sensitive at other site but not here send bulletin
     29 I $G(ARRAY("SENSITIVITY"))'="" S SENSTVTY=$G(ARRAY("SENSITIVITY")) D
     30 .N NAME S NAME=ARRAY("NAME")
     31 .I '$$SENSTIVE^RGRSENS(RGRSDFN),SENSTVTY D
     32 ..S ARAY("SSN")=ARRAY("SSN"),ARAY("SENDING SITE")=ARRAY("SENDING SITE")
     33 ..S ARAY("SENSITIVITY USER")=ARRAY("SENSITIVITY USER"),ARAY("SENSITIVITY DATE")=ARRAY("SENSITIVITY DATE")
     34 ..D SENSTIVE^RGRSBUL1(RGRSDFN,"ARAY",NAME)
     35 ;
     36 ;If patient has DATE OF DEATH (DOD) at remote site send bulletin
     37 ;Ignore time if present with date.
     38 S RMTDOD=$G(ARRAY("MPIDOD")),RMTDOD=$P(RMTDOD,".")
     39 S DFN=RGRSDFN D DEM^VADPT
     40 S LOCDOD=$P($P(VADM(6),"^"),".")
     41 ;If there is a remote DOD but no local DOD  OR if remote DOD is different from local DOD, send bulletin
     42 I RMTDOD D
     43 .N NAME S NAME=ARRAY("NAME"),ARAY("SSN")=ARRAY("SSN"),ARAY("SENDING SITE")=ARRAY("SENDING SITE")
     44 .D RMTDOD^RGRSBUL1(RGRSDFN,"ARAY",NAME,RMTDOD,LOCDOD)
     45 K VADM
     46 ;
     47NOTLOC I 'RGLOCAL D
     48 .;if sending site is not the CMOR AND NOT THE MPI - log update into PDR if differences exist **45 ADDED MPI
     49 .I (OTHSITE)'=(CMOR)&(OTHSITE'="200M") D  Q
     50 ..S VAFCA=$P($$NOW^XLFDT,".")_"^"_$$NOW^XLFDT_"^"_$G(ARRAY("SENDING SITE"))_"^"_RGRSDFN
     51 ..S ARRAY(.01)=$$FREE^RGRSPARS(ARRAY("NAME")),ARRAY(.03)=$$FREE^RGRSPARS($G(ARRAY("MPIDOB")))
     52 ..S ARRAY(.09)=$$FREE^RGRSPARS($G(ARRAY("SSN"))),ARRAY(.02)=$$SEX^RGRSPARS($G(ARRAY("SEX")))
     53 ..S ARRAY(.2403)=$$FREE^RGRSPARS($G(ARRAY("MMN"))),ARRAY(991.01)=$P($G(ARRAY("ICN")),"V")
     54 ..N ARAY M ARAY(2)=ARRAY
     55 ..S VAFCA08=1 S BOGUS=$$ADD^VAFCEHU1(VAFCA,"ARAY")
     56 .;if sending site is the CMOR OR MPI - synchronize data **45 ADDED MPI AND SSNV TO UPDATED FIELDS
     57 .I (OTHSITE)=(CMOR)!(OTHSITE="200M") D
     58 ..;**44 is there an outstanding edit in the ADT/HL7 PIVOT file for this patient for an identity element
     59 ..S RGER=$$CHKPVT^RGADTP3(.ARRAY) Q:+RGER<0
     60 ..N DR,ARAY2 S RGER=""
     61 ..D DIFF^RGADTP3(.ARRAY,RGRSDFN,.DR,.ARRAY) ;**47
     62 ..I DR'="" D
     63 ...S VAFCA08=1,ARAY(2,.01)=ARRAY("NAME"),ARAY(2,.03)=$G(ARRAY("MPIDOB"))
     64 ...I ARRAY("SSN")'="" S ARAY(2,.09)=$G(ARRAY("SSN")) ;**45 only set SSN to update if it isn't null
     65 ...S ARAY(2,.02)=$G(ARRAY("SEX")),ARAY(2,.2403)=$G(ARRAY("MMN")),ARAY(2,994)=$G(ARRAY("MBI"))
     66 ...;**48 ONLY SET SSN VERIFICATION STATUS AND PSEUDO SSN REASON IF SSN UPDATE WAS SUCCESSFUL
     67 ...I $D(ARRAY("ALIAS")) M ARAY(2,1)=ARRAY("ALIAS") ;**48 ADD ALIAS TO MIX
     68 ...D EDIT^VAFCPTED(RGRSDFN,"ARAY(2)",DR)
     69 ...;check to see if edits were successful, if not set RGER="why it failed"
     70 ...N NAME,SSN,PDOB,SEX,MMN,OLDNAME,OLDHLNAM,OLDMMN,OLDHLMMN,HLNAME,HLMMN,SSNV,MBI
     71 ...S NAME=$$GET1^DIQ(2,+RGRSDFN_",",.01,"I"),PDOB=$$GET1^DIQ(2,+RGRSDFN_",",.03,"I")
     72 ...S SSN=$$GET1^DIQ(2,+RGRSDFN_",",.09,"I"),SEX=$$GET1^DIQ(2,+RGRSDFN_",",.02,"I")
     73 ...S MMN=$$GET1^DIQ(2,+RGRSDFN_",",.2403,"I"),MBI=$$GET1^DIQ(2,+RGRSDFN_",",994,"I")
     74 ...D STDNAME^XLFNAME(.NAME,"F",.OLDNAME) S HLNAME=ARRAY("NAME") D STDNAME^XLFNAME(.HLNAME,"F",.OLDHLNAM)
     75 ...I NAME'=$G(HLNAME) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"Name field failure"
     76 ...I PDOB'=$G(ARRAY("MPIDOB")) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"DOB field failure"
     77 ...;**48
     78 ...I SSN["P" D
     79 ....;if pseudo SSN reason field has been added to the DD then attempt to set it
     80 ....N PS,ERROR,LABEL D FIELD^DID(2,.0906,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
     81 .....S ARAY2(2,.0906)=$G(ARRAY(.0906)),DR=".0906;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
     82 .....S PS=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I")
     83 .....I PS=""&(ARAY2(2,.0906)="@") Q
     84 .....I PS'=ARAY2(2,.0906) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"Pseudo SSN Reason field failure"
     85 .....I PS=ARAY2(2,.0906) D
     86 ......K ARAY2 N ERROR,LABEL D FIELD^DID(2,.0907,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
     87 ......S ARAY2(2,.0907)=$G(ARRAY(.0907)),DR=".0907;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
     88 ......S SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I")
     89 ......S:$G(ARRAY(.0907))="@" ARRAY(.0907)="" I SSNV'=$G(ARRAY(.0907)) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SSN VERIFICATION field failure"
     90 ...I $G(ARRAY("SSN"))'="",SSN'=$G(ARRAY("SSN")) D
     91 ....I $G(ARRAY("SSN"))="P",SSN["P" Q  ;**47 NEEDED TO CREATE PSEUDO AND DID
     92 ....S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SSN field failure" ;**45 only check if SSN is sent isn't null
     93 ...I SSN=$G(ARRAY("SSN")) D
     94 ....;if SSN VERIFICATION STATUS field has been added to the DD then attempt to set it
     95 ....K ARAY2 N ERROR,LABEL D FIELD^DID(2,.0907,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
     96 .....S ARAY2(2,.0907)=$G(ARRAY(.0907)) S DR=".0907;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
     97 .....S SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I")
     98 .....S:$G(ARRAY(.0907))="@" ARRAY(.0907)="" I SSNV'=$G(ARRAY(.0907)) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SSN VERIFICATION field failure"
     99 .....I SSNV'="" D
     100 ......N PS,ERROR,LABEL D FIELD^DID(2,.0906,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
     101 ......S ARAY2(2,.0906)=$G(ARRAY(.0906)) S DR=".0906;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
     102 ......S PS=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I")
     103 ......I PS=""&(ARAY2(2,.0906)="@") Q
     104 ......S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"Pseudo SSN Reason field failure"
     105 ...I SEX'=$G(ARRAY("SEX")) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SEX field failure"
     106 ...D STDNAME^XLFNAME(.MMN,"F",.OLDMMN) S HLMMN=ARRAY("MMN") D STDNAME^XLFNAME(.HLMMN,"F",.OLDHLMMN)
     107 ...I MMN'=$G(HLMMN) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"MOTHER'S MAIDEN NAME field failure"
     108 ...;**REMOVED MBI FROM PATCH 45 PUT BACK IN **47
     109 ...I MBI'=$G(ARRAY("MBI")) D
     110 ....Q:MBI=""&($G(ARRAY("MBI"))="@")  ;**47 "" AND @ ARE THE SAME
     111 ....S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"MULTIPLE BIRTH INDICATOR field failure"
     112 ...;send the updated fields to the MPI to synch site with MPI
     113 ...I HL("ETN")'="A31" S ZTSAVE("DFN")="",ZTRTN="MPISYN^RGADTPC",ZTDESC="Sending Synchronized Patient Data to MPI...",ZTIO="RG QUEUE",ZTDTH=$H D ^%ZTLOAD
     114 ...;**45 ^ don't trigger A31 sync message if A31 was being processed-- ack to a31 will sync id elements on MPI
     115 Q
Note: See TracChangeset for help on using the changeset viewer.