source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASPFSS.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1EASPFSS ;OAK/ELZ - PFSS SUPPORT FOR INBOUND LTC STATUS MESSAGE; 10/6/05
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**67**;21-OCT-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5MSG ; receives HL7 message from COTS product
6 N EASMSG,EASHEAD,EASICN,EASDFN,EASSSN,EASVACLM,EASALIAS,EASSTAT,EASD,EAST,EASRESLT,EASDT,EASLOS,EASCODE,SEG,EASX
7 ;
8 ;parse message
9 S EASSTAT=$$STARTMSG^HLPRS(.EASMSG,HLMTIENS,.EASHEAD)
10 I 'EASSTAT S HLERR="Unable to start parse of message" G MSGQ
11 ;
12 F Q:'$$NEXTSEG^HLPRS(.EASMSG,.SEG) D
13 . F EAST=3:1 S EASD=$P($T(HL7DATA+EAST),";",4) Q:EASD="" D
14 . . I $P(EASD,"^",2)=SEG("SEGMENT TYPE") D
15 . . . S @$P(EASD,"^")=$$GET^HLOPRS(.SEG,$P(EASD,"^",3),$P(EASD,"^",4),$P(EASD,"^",5),$P(EASD,"^",6))
16 . . . S EASCODE=$P(EASD,"^",7,99)
17 . . . I $L(EASCODE),$L(@$P(EASD,"^")) S X=@$P(EASD,"^") X EASCODE S @$P(EASD,"^")=X
18 ;
19 ;check out data received from message
20 S DFN=$$PATIENT($G(EASICN),$G(EASDFN),$G(EASSSN),$G(EASVACLM),$G(EASALIAS)) I 'DFN S HLERR="Unable to validate the patient" G MSGQ
21 ;
22 ;data for $$copay^easeccal call
23 ; input: Patient's DFN, Date of Care, Length of stay
24 ; output: exemption flag ^ exemption reason (714.1 pointer) ^ <181 $ amount ^ >180 $ amount ^ opt $ amount
25 ;
26 S EASX=$$FILE(DFN,EASDT,EASLOS,$$COPAY^EASECCAL(DFN,EASDT,EASLOS)) I EASX<1 S HLERR="Unable to create 714.5 record" G MSGQ
27 ;
28 S EASX=$$QUEUE^VDEFQM("ADT^A08","SUBTYPE=LTUPI^IEN="_EASX,,"PFSS OUTBOUND") I 'EASX S HLERR="Unable to queue to VDEF"
29 ;
30MSGQ ;
31 S HLA("HLA",1)="MSA"_HL("FS")_$S('$D(HLERR):"AA",1:"AE")_HL("FS")_HL("MID")
32 D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.EASRESLT)
33 ;
34 Q
35 ;
36FILE(DFN,EASDT,EASLOS,EASDAT) ; creates a new entry in 714.5 and returns ien
37 ;
38 N DIC,DO,X,Y
39 S DIC="^EASPFS(714.5,",DIC(0)="",X=DFN
40 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)"
41 S:$P(EASDAT,"^",2) DIC("DR")=DIC("DR")_";.05////^S X=$P(EASDAT,""^"",2)"
42 D FILE^DICN
43 Q +Y
44 ;
45PATIENT(EASICN,EASDFN,EASSSN,EASVACLM,EASALIAS) ; this function will receive
46 ; several patient data elements and validate them. Assuming the data
47 ; meets expected requirements, the function will return the patient's
48 ; DFN. The requirement is ICN is a must, the patient must also match
49 ; at least 2 other data elements.
50 ;
51 N DFN,EASMATCH,EASX
52 S (EASMATCH,EASX)=0
53 S DFN=$$DFN(EASICN) I 'DFN G PATQ
54 I DFN=EASDFN S EASMATCH=1
55 I $P($G(^DPT(DFN,0)),"^",9)=EASSSN S EASMATCH=EASMATCH+1 I EASMATCH>1 G PATQ
56 I $P($G(^DPT(DFN,.31)),"^",3)=EASVACLM S EASMATCH=EASMATCH+1 I EASMATCH>1 G PATQ
57 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
58 I EASMATCH<2 S DFN=0
59PATQ ;
60 Q DFN
61 ;
62DFN(EASICN) ; returns dfn for icn ia #2701
63 N DFN ; check to see if mpi software installed
64 S DFN=$S($L($T(GETDFN^MPIF001)):+$$GETDFN^MPIF001(+EASICN),1:0)
65 Q $S(DFN>0:DFN,1:0)
66 ;
67HL7DATA ; hl7 data mapping
68 ; format: description ; EAS Variable ^ segment ^ seq ^ comp ^ subcomp ^
69 ; extract code
70 ;;patient icn;EASICN^PID^3^1^1^1
71 ;;patient dfn;EASDFN^PID^3^1^1^2^S X=$E(X,4,99)
72 ;;patient ssn;EASSSN^PID^3^1^1^3
73 ;;patient va claim;EASVACLM^PID^3^1^1^4
74 ;;patient alias ssn;EASALIAS^PID^3^1^1^5
75 ;;last month date;EASDT^OBX^14^1^^^S X=$$FMDATE^HLFNC(X)
76 ;;ltc los;EASLOS^OBX^5
77 ;;
78 ;
Note: See TracBrowser for help on using the repository browser.