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

MPIFA31I.m

Go to the documentation of this file. 
  1. MPIFA31I ;ALB/JRP-PROCESS ADT-A31 MESSAGE FROM MPI ; 1/4/12 12:56pm
  1.  ;;1.0;MASTER PATIENT INDEX VISTA;**1,21,54**;30 Apr 99;Build 2
  1.  ;
  1.  ; Integration Agreements Utilized:
  1.  ;  ^DGCN(391.91 - #2751
  1.  ;  ^DPT("AICNL" - #2070
  1.  ;  EXC^RGHLLOG - #2796
  1.  ;
  1. PROCESS(MSGARR) ;Process ADT-A31 message received from MPI when a new
  1.  ; patient is assigned an Integration Control Number
  1.  ;
  1.  ;Input  : MSGARR - Array containing ADT-A31 message (full global ref)
  1.  ;                - MSGARR must be in format compatible with interaction
  1.  ;                  with DHCP HL7 package
  1.  ;                    MSGARR(1) = First segment of message
  1.  ;                    MSGARR(1,n) = Continuation node(s) for segment
  1.  ;                    MSGARR(x) = Xth segment of message
  1.  ;                    MSGARR(x,n) = Continuation node(s) for segment
  1.  ;                - Defaults to ^TMP("MPIFA31",$J,"MPI-ADT-A31")
  1.  ;Output : ICN = Successfully processed
  1.  ;        -1^Reason = Failure
  1.  ;Notes  : The MPI uses an ADT-A31 message to return the ICN of new
  1.  ;         patients.  This value (seq # 2 of PID segment) is the only
  1.  ;         information that will be stored.
  1.  ;
  1.  ;Check input
  1.  S MSGARR=$G(MSGARR)
  1.  S:(MSGARR="") MSGARR="^TMP(""MPIFA31"","_$J_",""MPI-ADT-A31"")"
  1.  Q:(('$D(@MSGARR))!('$O(@MSGARR@(0)))) "-1^Array containing ADT-A31 message not valid"
  1.  ;Declare variables
  1.  N MSH,EVN,PID,SEND,RECEIVE,EVENT,REASON,SEGMENT,SEGNAME
  1.  N ICN,ICNNUM,ICNCHECK,DFNCHECK,CHKSCHM,SSN,LOCAL,TMP,FLDSEP,HLECH
  1.  N CMPSEP,REPSEP,ESC,SUBSEP,TMP1,TMP2
  1.  ;Parse required segments out of message
  1.  S (MSH,EVN,PID)=""
  1.  S TMP=0
  1.  F  S TMP=+$O(@MSGARR@(TMP)) Q:('TMP)  D
  1.  .;Get segment and screen out unused segments
  1.  .S SEGMENT=$G(@MSGARR@(TMP))
  1.  .S SEGNAME=$E(SEGMENT,1,3)
  1.  .S TMP1=","_SEGNAME_","
  1.  .Q:('(",MSH,EVN,PID,"[TMP1))
  1.  .;Use first occurrance of segment
  1.  .Q:(@SEGNAME'="")
  1.  .;Remember field separator if MSH segment
  1.  .S:(SEGNAME="MSH") FLDSEP=$E(SEGMENT,4)
  1.  .;Drop segment name and field separator for storage
  1.  .S @SEGNAME=$E(SEGMENT,5,$L(SEGMENT))
  1.  .;Account for rollover (begin rollover subscripting with 1)
  1.  .S TMP1=0
  1.  .S TMP2=1
  1.  .F  S TMP1=+$O(@MSGARR@(TMP,TMP1)) Q:('TMP1)  D
  1.  ..;Get/save rollover
  1.  ..S @SEGNAME@(TMP2)=$G(@MSGARR@(TMP,TMP1))
  1.  ..S TMP2=TMP2+1
  1.  ;Make sure used segments were all found
  1.  F SEGNAME="MSH","EVN","PID" Q:(@SEGNAME="")
  1.  Q:(@SEGNAME="") "-1^Required segment ("_SEGNAME_") missing"
  1.  ;Safety check on field separator (use DHCP default value)
  1.  S:($G(FLDSEP)="") FLDSEP="^"
  1.  ;Get encoding characters
  1.  S HLECH=$P(MSH,FLDSEP,1)
  1.  ;Component separator
  1.  S CMPSEP=$E(HLECH,1)
  1.  ;Repetion separator
  1.  S REPSEP=$E(HLECH,2)
  1.  ;Escape character
  1.  S ESC=$E(HLECH,3)
  1.  ;Subcomponent separator
  1.  S SUBSEP=$E(HLECH,4)
  1.  ;Process MSH segment
  1.  ; - Get sending facility
  1.  S SEND=$P(MSH,FLDSEP,3)
  1.  ; - Get receiving facility
  1.  S RECEIVE=$P(MSH,FLDSEP,5)
  1.  ; - Get event type
  1.  S EVENT=$P($P(MSH,FLDSEP,8),CMPSEP,2)
  1.  ; - Validate information in MSH segment
  1.  ;   - MPI is sending facility
  1.  ;Q:(SEND'="200M") "-1^Sending facility not valid (must be '200M')"
  1.  ;   - Receiving facility is local facility
  1.  S TMP=+$P($$SITE^VASITE(),"^",3)
  1.  Q:(RECEIVE'=TMP) "-1^Receiving facility not valid (must be "_TMP_")"
  1.  ;   - Event type is A31
  1.  Q:(EVENT'="A31") "-1^Event type not valid (must be 'A31')"
  1.  ;Process EVN segment
  1.  ; - Get event reason
  1.  S REASON=$P(EVN,FLDSEP,4)
  1.  ; - Validate information in EVN segment
  1.  ;   - Event reason is 95
  1.  Q:(REASON'="95") "-1^Event reason code not valid (must be '95')"
  1.  ;Process PID segment
  1.  ; - Get ICN & checksum & checksum scheme
  1.  S TMP=$P(PID,FLDSEP,2)
  1.  S ICN=$P(TMP,CMPSEP,1)
  1.  Q:(ICN'?1.16N1"V"6N) "-1^ICN not in correct format"
  1.  S ICNNUM=$P(ICN,"V",1)
  1.  S ICNCHECK=$P(TMP,"V",2)
  1.  Q:((ICNNUM="")!(ICNCHECK="")) "-1^Could not determine ICN"
  1.  ; - Validate checksum
  1.  Q:(ICNCHECK'=$$CHECKDG^MPIFSPC(ICNNUM)) "-1^ICN/checksum not valid"
  1.  ; - Get DFN & checksum & checksum scheme
  1.  S TMP=$P(PID,FLDSEP,3)
  1.  ; - Get SSN (account for roll over)
  1.  S SSN=""
  1.  S TMP=$L(PID,FLDSEP)
  1.  S TMP1=$P(PID,FLDSEP,TMP)
  1.  S:(TMP=19) SSN=$P(PID,FLDSEP,19)_$P($G(PID(1)),FLDSEP,1)
  1.  S:(TMP>19) SSN=$P(PID,FLDSEP,19)
  1.  S:(TMP<19) SSN=$P($G(PID(1)),FLDSEP,((19-TMP)+1))
  1.  ; - Validate information in PID
  1.  ;   - Make sure DFN exists
  1.  S LOCAL=$G(^DPT(DFN,0))
  1.  Q:($P(LOCAL,"^",1)="") "-1^Could not locate patient (bad DFN)"
  1.  ;   - Make sure SSNs match
  1.  Q:($P(LOCAL,"^",9)'=SSN) "-1^DFN/SSN pairing not valid"
  1.  ;Extra validation checks
  1.  ; - Verify lack of national ICN
  1.  I ($$GETICN^MPIF001(DFN)>0) Q:('$D(^DPT("AICNL",1,DFN))) "-1^National ICN already assigned to patient"
  1.  ;Passed all validation checks - store ICN & checksum
  1.  S TMP=$$SETICN^MPIF001(DFN,ICNNUM,ICNCHECK)
  1.  Q:(TMP<0) "-1^Unable to store ICN and checksum"
  1.  ;Delete local ICN flag
  1.  S TMP=$$SETLOC^MPIF001(DFN,0)
  1.  S TMP=$$CHANGE^MPIF001(DFN,+$$SITE^VASITE)
  1.  N HERE,TFSITE
  1.  S HERE=+$P($$SITE^VASITE,"^",3)
  1.  S TFSITE=$$LKUP^XUAF4(HERE)
  1.  Q:+TFSITE'>0 ICN
  1.  Q:$D(^DGCN(391.91,"APAT",DFN,TFSITE)) ICN
  1.  ;**54 MVI_1009 (ckn) - Commented following un necessary code
  1.  ;K DD,DO N DIC,X,Y
  1.  ;S DIC="^DGCN(391.91,",DIC("DR")=".02///`"_TFSITE,X=DFN,DIC(0)="LQZ"
  1.  ;D FILE^DICN
  1.  ;I +Y=-1 S ^XTMP($J,"MPIF","MSHERR")="Treating Facility Add Failed" D
  1.  ;.D EXC^RGHLLOG(212,"DFN= "_DFN_"  Treating Facility= "_TFSITE,DFN)
  1.  ;K DD,DO,DIC,X,Y
  1.  ;Done
  1.  Q ICN