EASPFSS ;OAK/ELZ - PFSS SUPPORT FOR INBOUND LTC STATUS MESSAGE; 10/6/05
;;1.0;ENROLLMENT APPLICATION SYSTEM;**67**;21-OCT-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
MSG ; receives HL7 message from COTS product
N EASMSG,EASHEAD,EASICN,EASDFN,EASSSN,EASVACLM,EASALIAS,EASSTAT,EASD,EAST,EASRESLT,EASDT,EASLOS,EASCODE,SEG,EASX
;
;parse message
S EASSTAT=$$STARTMSG^HLPRS(.EASMSG,HLMTIENS,.EASHEAD)
I 'EASSTAT S HLERR="Unable to start parse of message" G MSGQ
;
F Q:'$$NEXTSEG^HLPRS(.EASMSG,.SEG) D
. F EAST=3:1 S EASD=$P($T(HL7DATA+EAST),";",4) Q:EASD="" D
. . I $P(EASD,"^",2)=SEG("SEGMENT TYPE") D
. . . S @$P(EASD,"^")=$$GET^HLOPRS(.SEG,$P(EASD,"^",3),$P(EASD,"^",4),$P(EASD,"^",5),$P(EASD,"^",6))
. . . S EASCODE=$P(EASD,"^",7,99)
. . . I $L(EASCODE),$L(@$P(EASD,"^")) S X=@$P(EASD,"^") X EASCODE S @$P(EASD,"^")=X
;
;check out data received from message
S DFN=$$PATIENT($G(EASICN),$G(EASDFN),$G(EASSSN),$G(EASVACLM),$G(EASALIAS)) I 'DFN S HLERR="Unable to validate the patient" G MSGQ
;
;data for $$copay^easeccal call
; input: Patient's DFN, Date of Care, Length of stay
; output: exemption flag ^ exemption reason (714.1 pointer) ^ <181 $ amount ^ >180 $ amount ^ opt $ amount
;
S EASX=$$FILE(DFN,EASDT,EASLOS,$$COPAY^EASECCAL(DFN,EASDT,EASLOS)) I EASX<1 S HLERR="Unable to create 714.5 record" G MSGQ
;
S EASX=$$QUEUE^VDEFQM("ADT^A08","SUBTYPE=LTUPI^IEN="_EASX,,"PFSS OUTBOUND") I 'EASX S HLERR="Unable to queue to VDEF"
;
MSGQ ;
S HLA("HLA",1)="MSA"_HL("FS")_$S('$D(HLERR):"AA",1:"AE")_HL("FS")_HL("MID")
D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.EASRESLT)
;
Q
;
FILE(DFN,EASDT,EASLOS,EASDAT) ; creates a new entry in 714.5 and returns ien
;
N DIC,DO,X,Y
S DIC="^EASPFS(714.5,",DIC(0)="",X=DFN
S DIC("DR")=".02////^S X=EASDT;.03////^S X=EASLOS;.04////^S X=+EASDAT;.06////^S X=+$P(EASDAT,""^"",3);.07////^S X=+$P(EASDAT,""^"",4);.08////^S X=+$P(EASDAT,""^"",5)"
S:$P(EASDAT,"^",2) DIC("DR")=DIC("DR")_";.05////^S X=$P(EASDAT,""^"",2)"
D FILE^DICN
Q +Y
;
PATIENT(EASICN,EASDFN,EASSSN,EASVACLM,EASALIAS) ; this function will receive
; several patient data elements and validate them. Assuming the data
; meets expected requirements, the function will return the patient's
; DFN. The requirement is ICN is a must, the patient must also match
; at least 2 other data elements.
;
N DFN,EASMATCH,EASX
S (EASMATCH,EASX)=0
S DFN=$$DFN(EASICN) I 'DFN G PATQ
I DFN=EASDFN S EASMATCH=1
I $P($G(^DPT(DFN,0)),"^",9)=EASSSN S EASMATCH=EASMATCH+1 I EASMATCH>1 G PATQ
I $P($G(^DPT(DFN,.31)),"^",3)=EASVACLM S EASMATCH=EASMATCH+1 I EASMATCH>1 G PATQ
F S EASX=$O(^DPT(DFN,.01,EASX)) Q:'EASX!(EASMATCH>1) I $P($G(^DPT(DFN,.01,EASX,0)),"^",2)=EASALIAS S EASMATCH=EASMATCH+1 Q
I EASMATCH<2 S DFN=0
PATQ ;
Q DFN
;
DFN(EASICN) ; returns dfn for icn ia #2701
N DFN ; check to see if mpi software installed
S DFN=$S($L($T(GETDFN^MPIF001)):+$$GETDFN^MPIF001(+EASICN),1:0)
Q $S(DFN>0:DFN,1:0)
;
HL7DATA ; hl7 data mapping
; format: description ; EAS Variable ^ segment ^ seq ^ comp ^ subcomp ^
; extract code
;;patient icn;EASICN^PID^3^1^1^1
;;patient dfn;EASDFN^PID^3^1^1^2^S X=$E(X,4,99)
;;patient ssn;EASSSN^PID^3^1^1^3
;;patient va claim;EASVACLM^PID^3^1^1^4
;;patient alias ssn;EASALIAS^PID^3^1^1^5
;;last month date;EASDT^OBX^14^1^^^S X=$$FMDATE^HLFNC(X)
;;ltc los;EASLOS^OBX^5
;;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASPFSS 3476 printed Sep 23, 2025@19:31:40 Page 2
EASPFSS ;OAK/ELZ - PFSS SUPPORT FOR INBOUND LTC STATUS MESSAGE; 10/6/05
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**67**;21-OCT-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
MSG ; receives HL7 message from COTS product
+1 NEW EASMSG,EASHEAD,EASICN,EASDFN,EASSSN,EASVACLM,EASALIAS,EASSTAT,EASD,EAST,EASRESLT,EASDT,EASLOS,EASCODE,SEG,EASX
+2 ;
+3 ;parse message
+4 SET EASSTAT=$$STARTMSG^HLPRS(.EASMSG,HLMTIENS,.EASHEAD)
+5 IF 'EASSTAT
SET HLERR="Unable to start parse of message"
GOTO MSGQ
+6 ;
+7 FOR
if '$$NEXTSEG^HLPRS(.EASMSG,.SEG)
QUIT
Begin DoDot:1
+8 FOR EAST=3:1
SET EASD=$PIECE($TEXT(HL7DATA+EAST),";",4)
if EASD=""
QUIT
Begin DoDot:2
+9 IF $PIECE(EASD,"^",2)=SEG("SEGMENT TYPE")
Begin DoDot:3
+10 SET @$PIECE(EASD,"^")=$$GET^HLOPRS(.SEG,$PIECE(EASD,"^",3),$PIECE(EASD,"^",4),$PIECE(EASD,"^",5),$PIECE(EASD,"^",6))
+11 SET EASCODE=$PIECE(EASD,"^",7,99)
+12 IF $LENGTH(EASCODE)
IF $LENGTH(@$PIECE(EASD,"^"))
SET X=@$PIECE(EASD,"^")
XECUTE EASCODE
SET @$PIECE(EASD,"^")=X
End DoDot:3
End DoDot:2
End DoDot:1
+13 ;
+14 ;check out data received from message
+15 SET DFN=$$PATIENT($GET(EASICN),$GET(EASDFN),$GET(EASSSN),$GET(EASVACLM),$GET(EASALIAS))
IF 'DFN
SET HLERR="Unable to validate the patient"
GOTO MSGQ
+16 ;
+17 ;data for $$copay^easeccal call
+18 ; input: Patient's DFN, Date of Care, Length of stay
+19 ; output: exemption flag ^ exemption reason (714.1 pointer) ^ <181 $ amount ^ >180 $ amount ^ opt $ amount
+20 ;
+21 SET EASX=$$FILE(DFN,EASDT,EASLOS,$$COPAY^EASECCAL(DFN,EASDT,EASLOS))
IF EASX<1
SET HLERR="Unable to create 714.5 record"
GOTO MSGQ
+22 ;
+23 SET EASX=$$QUEUE^VDEFQM("ADT^A08","SUBTYPE=LTUPI^IEN="_EASX,,"PFSS OUTBOUND")
IF 'EASX
SET HLERR="Unable to queue to VDEF"
+24 ;
MSGQ ;
+1 SET HLA("HLA",1)="MSA"_HL("FS")_$SELECT('$DATA(HLERR):"AA",1:"AE")_HL("FS")_HL("MID")
+2 DO GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.EASRESLT)
+3 ;
+4 QUIT
+5 ;
FILE(DFN,EASDT,EASLOS,EASDAT) ; creates a new entry in 714.5 and returns ien
+1 ;
+2 NEW DIC,DO,X,Y
+3 SET DIC="^EASPFS(714.5,"
SET DIC(0)=""
SET X=DFN
+4 SET DIC("DR")=".02////^S X=EASDT;.03////^S X=EASLOS;.04////^S X=+EASDAT;.06////^S X=+$P(EASDAT,""^"",3);.07////^S X=+$P(EASDAT,""^"",4);.08////^S X=+$P(EASDAT,""^"",5)"
+5 if $PIECE(EASDAT,"^",2)
SET DIC("DR")=DIC("DR")_";.05////^S X=$P(EASDAT,""^"",2)"
+6 DO FILE^DICN
+7 QUIT +Y
+8 ;
PATIENT(EASICN,EASDFN,EASSSN,EASVACLM,EASALIAS) ; this function will receive
+1 ; several patient data elements and validate them. Assuming the data
+2 ; meets expected requirements, the function will return the patient's
+3 ; DFN. The requirement is ICN is a must, the patient must also match
+4 ; at least 2 other data elements.
+5 ;
+6 NEW DFN,EASMATCH,EASX
+7 SET (EASMATCH,EASX)=0
+8 SET DFN=$$DFN(EASICN)
IF 'DFN
GOTO PATQ
+9 IF DFN=EASDFN
SET EASMATCH=1
+10 IF $PIECE($GET(^DPT(DFN,0)),"^",9)=EASSSN
SET EASMATCH=EASMATCH+1
IF EASMATCH>1
GOTO PATQ
+11 IF $PIECE($GET(^DPT(DFN,.31)),"^",3)=EASVACLM
SET EASMATCH=EASMATCH+1
IF EASMATCH>1
GOTO PATQ
+12 FOR
SET EASX=$ORDER(^DPT(DFN,.01,EASX))
if 'EASX!(EASMATCH>1)
QUIT
IF $PIECE($GET(^DPT(DFN,.01,EASX,0)),"^",2)=EASALIAS
SET EASMATCH=EASMATCH+1
QUIT
+13 IF EASMATCH<2
SET DFN=0
PATQ ;
+1 QUIT DFN
+2 ;
DFN(EASICN) ; returns dfn for icn ia #2701
+1 ; check to see if mpi software installed
NEW DFN
+2 SET DFN=$SELECT($LENGTH($TEXT(GETDFN^MPIF001)):+$$GETDFN^MPIF001(+EASICN),1:0)
+3 QUIT $SELECT(DFN>0:DFN,1:0)
+4 ;
HL7DATA ; hl7 data mapping
+1 ; format: description ; EAS Variable ^ segment ^ seq ^ comp ^ subcomp ^
+2 ; extract code
+3 ;;patient icn;EASICN^PID^3^1^1^1
+4 ;;patient dfn;EASDFN^PID^3^1^1^2^S X=$E(X,4,99)
+5 ;;patient ssn;EASSSN^PID^3^1^1^3
+6 ;;patient va claim;EASVACLM^PID^3^1^1^4
+7 ;;patient alias ssn;EASALIAS^PID^3^1^1^5
+8 ;;last month date;EASDT^OBX^14^1^^^S X=$$FMDATE^HLFNC(X)
+9 ;;ltc los;EASLOS^OBX^5
+10 ;;
+11 ;
