MPIFA31I ;ALB/JRP-PROCESS ADT-A31 MESSAGE FROM MPI ; 1/4/12 12:56pm
;;1.0;MASTER PATIENT INDEX VISTA;**1,21,54**;30 Apr 99;Build 2
;
; Integration Agreements Utilized:
; ^DGCN(391.91 - #2751
; ^DPT("AICNL" - #2070
; EXC^RGHLLOG - #2796
;
PROCESS(MSGARR) ;Process ADT-A31 message received from MPI when a new
; patient is assigned an Integration Control Number
;
;Input : MSGARR - Array containing ADT-A31 message (full global ref)
; - MSGARR must be in format compatible with interaction
; with DHCP HL7 package
; MSGARR(1) = First segment of message
; MSGARR(1,n) = Continuation node(s) for segment
; MSGARR(x) = Xth segment of message
; MSGARR(x,n) = Continuation node(s) for segment
; - Defaults to ^TMP("MPIFA31",$J,"MPI-ADT-A31")
;Output : ICN = Successfully processed
; -1^Reason = Failure
;Notes : The MPI uses an ADT-A31 message to return the ICN of new
; patients. This value (seq # 2 of PID segment) is the only
; information that will be stored.
;
;Check input
S MSGARR=$G(MSGARR)
S:(MSGARR="") MSGARR="^TMP(""MPIFA31"","_$J_",""MPI-ADT-A31"")"
Q:(('$D(@MSGARR))!('$O(@MSGARR@(0)))) "-1^Array containing ADT-A31 message not valid"
;Declare variables
N MSH,EVN,PID,SEND,RECEIVE,EVENT,REASON,SEGMENT,SEGNAME
N ICN,ICNNUM,ICNCHECK,DFNCHECK,CHKSCHM,SSN,LOCAL,TMP,FLDSEP,HLECH
N CMPSEP,REPSEP,ESC,SUBSEP,TMP1,TMP2
;Parse required segments out of message
S (MSH,EVN,PID)=""
S TMP=0
F S TMP=+$O(@MSGARR@(TMP)) Q:('TMP) D
.;Get segment and screen out unused segments
.S SEGMENT=$G(@MSGARR@(TMP))
.S SEGNAME=$E(SEGMENT,1,3)
.S TMP1=","_SEGNAME_","
.Q:('(",MSH,EVN,PID,"[TMP1))
.;Use first occurrance of segment
.Q:(@SEGNAME'="")
.;Remember field separator if MSH segment
.S:(SEGNAME="MSH") FLDSEP=$E(SEGMENT,4)
.;Drop segment name and field separator for storage
.S @SEGNAME=$E(SEGMENT,5,$L(SEGMENT))
.;Account for rollover (begin rollover subscripting with 1)
.S TMP1=0
.S TMP2=1
.F S TMP1=+$O(@MSGARR@(TMP,TMP1)) Q:('TMP1) D
..;Get/save rollover
..S @SEGNAME@(TMP2)=$G(@MSGARR@(TMP,TMP1))
..S TMP2=TMP2+1
;Make sure used segments were all found
F SEGNAME="MSH","EVN","PID" Q:(@SEGNAME="")
Q:(@SEGNAME="") "-1^Required segment ("_SEGNAME_") missing"
;Safety check on field separator (use DHCP default value)
S:($G(FLDSEP)="") FLDSEP="^"
;Get encoding characters
S HLECH=$P(MSH,FLDSEP,1)
;Component separator
S CMPSEP=$E(HLECH,1)
;Repetion separator
S REPSEP=$E(HLECH,2)
;Escape character
S ESC=$E(HLECH,3)
;Subcomponent separator
S SUBSEP=$E(HLECH,4)
;Process MSH segment
; - Get sending facility
S SEND=$P(MSH,FLDSEP,3)
; - Get receiving facility
S RECEIVE=$P(MSH,FLDSEP,5)
; - Get event type
S EVENT=$P($P(MSH,FLDSEP,8),CMPSEP,2)
; - Validate information in MSH segment
; - MPI is sending facility
;Q:(SEND'="200M") "-1^Sending facility not valid (must be '200M')"
; - Receiving facility is local facility
S TMP=+$P($$SITE^VASITE(),"^",3)
Q:(RECEIVE'=TMP) "-1^Receiving facility not valid (must be "_TMP_")"
; - Event type is A31
Q:(EVENT'="A31") "-1^Event type not valid (must be 'A31')"
;Process EVN segment
; - Get event reason
S REASON=$P(EVN,FLDSEP,4)
; - Validate information in EVN segment
; - Event reason is 95
Q:(REASON'="95") "-1^Event reason code not valid (must be '95')"
;Process PID segment
; - Get ICN & checksum & checksum scheme
S TMP=$P(PID,FLDSEP,2)
S ICN=$P(TMP,CMPSEP,1)
Q:(ICN'?1.16N1"V"6N) "-1^ICN not in correct format"
S ICNNUM=$P(ICN,"V",1)
S ICNCHECK=$P(TMP,"V",2)
Q:((ICNNUM="")!(ICNCHECK="")) "-1^Could not determine ICN"
; - Validate checksum
Q:(ICNCHECK'=$$CHECKDG^MPIFSPC(ICNNUM)) "-1^ICN/checksum not valid"
; - Get DFN & checksum & checksum scheme
S TMP=$P(PID,FLDSEP,3)
; - Get SSN (account for roll over)
S SSN=""
S TMP=$L(PID,FLDSEP)
S TMP1=$P(PID,FLDSEP,TMP)
S:(TMP=19) SSN=$P(PID,FLDSEP,19)_$P($G(PID(1)),FLDSEP,1)
S:(TMP>19) SSN=$P(PID,FLDSEP,19)
S:(TMP<19) SSN=$P($G(PID(1)),FLDSEP,((19-TMP)+1))
; - Validate information in PID
; - Make sure DFN exists
S LOCAL=$G(^DPT(DFN,0))
Q:($P(LOCAL,"^",1)="") "-1^Could not locate patient (bad DFN)"
; - Make sure SSNs match
Q:($P(LOCAL,"^",9)'=SSN) "-1^DFN/SSN pairing not valid"
;Extra validation checks
; - Verify lack of national ICN
I ($$GETICN^MPIF001(DFN)>0) Q:('$D(^DPT("AICNL",1,DFN))) "-1^National ICN already assigned to patient"
;Passed all validation checks - store ICN & checksum
S TMP=$$SETICN^MPIF001(DFN,ICNNUM,ICNCHECK)
Q:(TMP<0) "-1^Unable to store ICN and checksum"
;Delete local ICN flag
S TMP=$$SETLOC^MPIF001(DFN,0)
S TMP=$$CHANGE^MPIF001(DFN,+$$SITE^VASITE)
N HERE,TFSITE
S HERE=+$P($$SITE^VASITE,"^",3)
S TFSITE=$$LKUP^XUAF4(HERE)
Q:+TFSITE'>0 ICN
Q:$D(^DGCN(391.91,"APAT",DFN,TFSITE)) ICN
;**54 MVI_1009 (ckn) - Commented following un necessary code
;K DD,DO N DIC,X,Y
;S DIC="^DGCN(391.91,",DIC("DR")=".02///`"_TFSITE,X=DFN,DIC(0)="LQZ"
;D FILE^DICN
;I +Y=-1 S ^XTMP($J,"MPIF","MSHERR")="Treating Facility Add Failed" D
;.D EXC^RGHLLOG(212,"DFN= "_DFN_" Treating Facility= "_TFSITE,DFN)
;K DD,DO,DIC,X,Y
;Done
Q ICN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFA31I 5375 printed Dec 13, 2024@02:10:49 Page 2
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
+2 ;
+3 ; Integration Agreements Utilized:
+4 ; ^DGCN(391.91 - #2751
+5 ; ^DPT("AICNL" - #2070
+6 ; EXC^RGHLLOG - #2796
+7 ;
PROCESS(MSGARR) ;Process ADT-A31 message received from MPI when a new
+1 ; patient is assigned an Integration Control Number
+2 ;
+3 ;Input : MSGARR - Array containing ADT-A31 message (full global ref)
+4 ; - MSGARR must be in format compatible with interaction
+5 ; with DHCP HL7 package
+6 ; MSGARR(1) = First segment of message
+7 ; MSGARR(1,n) = Continuation node(s) for segment
+8 ; MSGARR(x) = Xth segment of message
+9 ; MSGARR(x,n) = Continuation node(s) for segment
+10 ; - Defaults to ^TMP("MPIFA31",$J,"MPI-ADT-A31")
+11 ;Output : ICN = Successfully processed
+12 ; -1^Reason = Failure
+13 ;Notes : The MPI uses an ADT-A31 message to return the ICN of new
+14 ; patients. This value (seq # 2 of PID segment) is the only
+15 ; information that will be stored.
+16 ;
+17 ;Check input
+18 SET MSGARR=$GET(MSGARR)
+19 if (MSGARR="")
SET MSGARR="^TMP(""MPIFA31"","_$JOB_",""MPI-ADT-A31"")"
+20 if (('$DATA(@MSGARR))!('$ORDER(@MSGARR@(0))))
QUIT "-1^Array containing ADT-A31 message not valid"
+21 ;Declare variables
+22 NEW MSH,EVN,PID,SEND,RECEIVE,EVENT,REASON,SEGMENT,SEGNAME
+23 NEW ICN,ICNNUM,ICNCHECK,DFNCHECK,CHKSCHM,SSN,LOCAL,TMP,FLDSEP,HLECH
+24 NEW CMPSEP,REPSEP,ESC,SUBSEP,TMP1,TMP2
+25 ;Parse required segments out of message
+26 SET (MSH,EVN,PID)=""
+27 SET TMP=0
+28 FOR
SET TMP=+$ORDER(@MSGARR@(TMP))
if ('TMP)
QUIT
Begin DoDot:1
+29 ;Get segment and screen out unused segments
+30 SET SEGMENT=$GET(@MSGARR@(TMP))
+31 SET SEGNAME=$EXTRACT(SEGMENT,1,3)
+32 SET TMP1=","_SEGNAME_","
+33 if ('(",MSH,EVN,PID,"[TMP1))
QUIT
+34 ;Use first occurrance of segment
+35 if (@SEGNAME'="")
QUIT
+36 ;Remember field separator if MSH segment
+37 if (SEGNAME="MSH")
SET FLDSEP=$EXTRACT(SEGMENT,4)
+38 ;Drop segment name and field separator for storage
+39 SET @SEGNAME=$EXTRACT(SEGMENT,5,$LENGTH(SEGMENT))
+40 ;Account for rollover (begin rollover subscripting with 1)
+41 SET TMP1=0
+42 SET TMP2=1
+43 FOR
SET TMP1=+$ORDER(@MSGARR@(TMP,TMP1))
if ('TMP1)
QUIT
Begin DoDot:2
+44 ;Get/save rollover
+45 SET @SEGNAME@(TMP2)=$GET(@MSGARR@(TMP,TMP1))
+46 SET TMP2=TMP2+1
End DoDot:2
End DoDot:1
+47 ;Make sure used segments were all found
+48 FOR SEGNAME="MSH","EVN","PID"
if (@SEGNAME="")
QUIT
+49 if (@SEGNAME="")
QUIT "-1^Required segment ("_SEGNAME_") missing"
+50 ;Safety check on field separator (use DHCP default value)
+51 if ($GET(FLDSEP)="")
SET FLDSEP="^"
+52 ;Get encoding characters
+53 SET HLECH=$PIECE(MSH,FLDSEP,1)
+54 ;Component separator
+55 SET CMPSEP=$EXTRACT(HLECH,1)
+56 ;Repetion separator
+57 SET REPSEP=$EXTRACT(HLECH,2)
+58 ;Escape character
+59 SET ESC=$EXTRACT(HLECH,3)
+60 ;Subcomponent separator
+61 SET SUBSEP=$EXTRACT(HLECH,4)
+62 ;Process MSH segment
+63 ; - Get sending facility
+64 SET SEND=$PIECE(MSH,FLDSEP,3)
+65 ; - Get receiving facility
+66 SET RECEIVE=$PIECE(MSH,FLDSEP,5)
+67 ; - Get event type
+68 SET EVENT=$PIECE($PIECE(MSH,FLDSEP,8),CMPSEP,2)
+69 ; - Validate information in MSH segment
+70 ; - MPI is sending facility
+71 ;Q:(SEND'="200M") "-1^Sending facility not valid (must be '200M')"
+72 ; - Receiving facility is local facility
+73 SET TMP=+$PIECE($$SITE^VASITE(),"^",3)
+74 if (RECEIVE'=TMP)
QUIT "-1^Receiving facility not valid (must be "_TMP_")"
+75 ; - Event type is A31
+76 if (EVENT'="A31")
QUIT "-1^Event type not valid (must be 'A31')"
+77 ;Process EVN segment
+78 ; - Get event reason
+79 SET REASON=$PIECE(EVN,FLDSEP,4)
+80 ; - Validate information in EVN segment
+81 ; - Event reason is 95
+82 if (REASON'="95")
QUIT "-1^Event reason code not valid (must be '95')"
+83 ;Process PID segment
+84 ; - Get ICN & checksum & checksum scheme
+85 SET TMP=$PIECE(PID,FLDSEP,2)
+86 SET ICN=$PIECE(TMP,CMPSEP,1)
+87 if (ICN'?1.16N1"V"6N)
QUIT "-1^ICN not in correct format"
+88 SET ICNNUM=$PIECE(ICN,"V",1)
+89 SET ICNCHECK=$PIECE(TMP,"V",2)
+90 if ((ICNNUM="")!(ICNCHECK=""))
QUIT "-1^Could not determine ICN"
+91 ; - Validate checksum
+92 if (ICNCHECK'=$$CHECKDG^MPIFSPC(ICNNUM))
QUIT "-1^ICN/checksum not valid"
+93 ; - Get DFN & checksum & checksum scheme
+94 SET TMP=$PIECE(PID,FLDSEP,3)
+95 ; - Get SSN (account for roll over)
+96 SET SSN=""
+97 SET TMP=$LENGTH(PID,FLDSEP)
+98 SET TMP1=$PIECE(PID,FLDSEP,TMP)
+99 if (TMP=19)
SET SSN=$PIECE(PID,FLDSEP,19)_$PIECE($GET(PID(1)),FLDSEP,1)
+100 if (TMP>19)
SET SSN=$PIECE(PID,FLDSEP,19)
+101 if (TMP<19)
SET SSN=$PIECE($GET(PID(1)),FLDSEP,((19-TMP)+1))
+102 ; - Validate information in PID
+103 ; - Make sure DFN exists
+104 SET LOCAL=$GET(^DPT(DFN,0))
+105 if ($PIECE(LOCAL,"^",1)="")
QUIT "-1^Could not locate patient (bad DFN)"
+106 ; - Make sure SSNs match
+107 if ($PIECE(LOCAL,"^",9)'=SSN)
QUIT "-1^DFN/SSN pairing not valid"
+108 ;Extra validation checks
+109 ; - Verify lack of national ICN
+110 IF ($$GETICN^MPIF001(DFN)>0)
if ('$DATA(^DPT("AICNL",1,DFN)))
QUIT "-1^National ICN already assigned to patient"
+111 ;Passed all validation checks - store ICN & checksum
+112 SET TMP=$$SETICN^MPIF001(DFN,ICNNUM,ICNCHECK)
+113 if (TMP<0)
QUIT "-1^Unable to store ICN and checksum"
+114 ;Delete local ICN flag
+115 SET TMP=$$SETLOC^MPIF001(DFN,0)
+116 SET TMP=$$CHANGE^MPIF001(DFN,+$$SITE^VASITE)
+117 NEW HERE,TFSITE
+118 SET HERE=+$PIECE($$SITE^VASITE,"^",3)
+119 SET TFSITE=$$LKUP^XUAF4(HERE)
+120 if +TFSITE'>0
QUIT ICN
+121 if $DATA(^DGCN(391.91,"APAT",DFN,TFSITE))
QUIT ICN
+122 ;**54 MVI_1009 (ckn) - Commented following un necessary code
+123 ;K DD,DO N DIC,X,Y
+124 ;S DIC="^DGCN(391.91,",DIC("DR")=".02///`"_TFSITE,X=DFN,DIC(0)="LQZ"
+125 ;D FILE^DICN
+126 ;I +Y=-1 S ^XTMP($J,"MPIF","MSHERR")="Treating Facility Add Failed" D
+127 ;.D EXC^RGHLLOG(212,"DFN= "_DFN_" Treating Facility= "_TFSITE,DFN)
+128 ;K DD,DO,DIC,X,Y
+129 ;Done
+130 QUIT ICN
