source: FOIAVistA/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASPTRN1.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1EASPTRN1 ;ALB/EJG,GN - GENERATE EAS SUBPROCESSES ; 11/09/2004
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**30,33,47,42,59**; 21-OCT-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; Cloned from IVMPTRN1
6 ;
7 ;EAS*1*47 - break up Z09's by Income year, via new "ATR" xref
8 ;EAS*1*42 - add RXCP testing to Expired tag
9 ;
10 ;
11DELMT ; send delete mt transaction if pt no longer meets IVM criteria
12 ;
13 ; Input - DFN
14 ; IVMMTDT - date of means test
15 ;
16 N I,IVMIY,X
17 S IVMIY=$$LYR^DGMTSCU1(IVMMTDT)
18 F I=1:1:5,8:1:14 S $P(X,HLFS,I)=HLQ
19 S ^TMP("HLS",$J,HLSDT,IVMCT)="ZMT"_HLFS_X
20 D CLOSE(IVMIY,DFN,2,3) ; set flag to stop future transmissions
21 Q
22 ;
23 ;
24CLOSE(IVMIY,DFN,IVMCS,IVMCR) ; Close IVM case record for a patient
25 ; Input: DFN -- Pointer to the patient in file #2
26 ; IVMIY -- Income year of the closed case
27 ; IVMCS -- Closure source [1=IVM | 2=DHCP]
28 ; IVMCR -- Pointer to the closure reason in file #301.93
29 ;
30 N DA,DIE,DR,X,Y,EVENTS,STATUS,EAEVENT,IVEVENT
31 I '$G(IVMIY)!'$G(DFN)!'$G(IVMCS)!'$G(IVMCR) G CLOSEQ
32 S IVMDELMT=1 ; flag indicates deletion
33 S DA=$O(^IVM(301.5,"APT",+DFN,+IVMIY,0))
34 I $G(^IVM(301.5,+DA,0))']"" G CLOSEQ
35 ;
36 ;don't want closing a case to stop transmission of an enrollment event
37 S STATUS=1
38 I ($$STATUS^IVMPLOG(+DA,.EVENTS)=0),EVENTS("ENROLL")=1 S STATUS=0
39 ;
40 ; If previous years event make sure Enrollment Event does not get
41 ; updated, and the IVM Event does
42 ;
43 S EAEVENT=1,IVEVENT=2
44 I $G(EXPIRED)=1 S EAEVENT=2,STATUS=0,IVEVENT=1
45 I $G(EXPIRED)=0 S EAEVENT=1,STATUS=0
46 D NOW^%DTC S DR=".03////"_STATUS_";.04////1;1.01////"_IVMCR_";1.02////"_IVMCS_";1.03////"_%_";30.01////"_IVEVENT_";30.02////2;30.03////"_$G(EAEVENT)
47 S DIE="^IVM(301.5," D ^DIE
48CLOSEQ Q
49 ;
50 ;
51PSEUDO ; strip P from pseudo SSNs before transmitting to IVM
52 ;
53 N X
54 S X=IVMPID_$G(IVMPID(1))
55 S $P(X,HLFS,20)=$E($P(X,HLFS,20),1,9) ; remove P
56 K IVMPID S IVMPID=$E(X,1,245)
57 I $L(X)>245 S IVMPID(1)=$E(X,246,999)
58 Q
59 ;
60 ;Check if EDB Z06 in Annual Means Test file #408.31
61 ; 'Z06 MT via Edb' will be stored in Comments if EDB Z06 Means Test
62 ;
63Z06MT(IVMMTIEN,Z06COM) N FLAG,LINE,COMMENT
64 I '$G(IVMMTIEN) Q 0
65 I $G(Z06COM)="" S Z06COM="Z06 MT via Edb"
66 S (FLAG,LINE)=0
67 F S LINE=$O(^DGMT(408.31,IVMMTIEN,"C",LINE)) Q:'LINE!(FLAG) D
68 . S COMMENT=$G(^DGMT(408.31,IVMMTIEN,"C",LINE,0))
69 . I COMMENT=Z06COM S FLAG=1 Q
70 Q FLAG
71 ;
72 ;Retrieve Means Test information from incoming HL7 message.
73 ;
74CHECKMT(DFN) N SOURCE,IVMLAST,IVMMTDT,IVMMTIEN
75 I IVMTYPE'=1 Q ;Only want MT = 1
76 S SOURCE=$P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,22)
77 S IVMMTDT=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,2))
78 S IVMLAST=$$LST^DGMTU(DFN,$E(IVMMTDT,1,3)_1231,1)
79 S IVMMTIEN=+IVMLAST
80 Q $$Z06MT(IVMMTIEN)
81 ;
82 ;Based upon DFN and MT Date find primary MT
83 ;
84VERZ06(DFN) N CMT,CMTDATE,MTIEN,PRIM
85 S CMT=$$LST^DGMTU(DFN)
86 S MTIEN=+CMT,CMTDATE=$P(CMT,"^",2)
87 I 'MTIEN Q 0 ;No Means Test found
88 S PRIM=$G(^DGMT(408.31,MTIEN,"PRIM"))
89 I PRIM,$$Z06MT(MTIEN) Q 1
90 Q 0
91 ;
92 ;Check for expired MT or CT ;EAS*1*42
93 ;
94EXPIRED(DFN,DGMTDT) N CMT,PMT,CCT,PCT
95 S (CMT,PMT,CCT,PCT)=""
96 S:DGMTYPT=2 PCT=$$LST^DGMTU(DFN,DGMTDT,2) ;Retrieve previous CT
97 S PMT=$$LST^DGMTU(DFN,DGMTDT,1) ;Retrieve previous MT
98 I PCT="",PMT="" Q 0
99 S:DGMTYPT=2 CCT=$$LST^DGMTU(DFN,DT,2) ;Retrieve current CT
100 S CMT=$$LST^DGMTU(DFN,DT,1) ;Retrieve current MT
101 ;check for any expired test
102 I DGMTYPT=2,$P(PCT,"^",2)<$P(CCT,"^",2) Q 1 ;Prev Yr CT is Expired
103 I $P(PMT,"^",2)<$P(CMT,"^",2) Q 1 ;Prev Yr MT is Expired
104 Q 0
105 ;
106 ;Determine if Z09 should be sent to EDB or HEC legacy ;EAS*1*47
107 ; Input: DFN
108 ; Output: Where to Send Z09
109 ; 0 - HEC Legacy
110 ; 1 - EDB
111 ;
112WHERETO(ICYR,DFN) N COM,DATE,FOUND,FRMDATE,IEN,MIEN,ONODE,MTD,TYPE,Z06COM
113 S FOUND=0
114 S Z06COM="Z06 MT via Edb"
115 S IEN=$O(^IVM(301.61,"ATR",ICYR,DFN,0)) I IEN="" Q FOUND
116 S FRMDATE=$P($G(^IVM(301.61,IEN,0)),"^",5) I FRMDATE="" Q FOUND
117 S TYPE=""
118 F S TYPE=$O(^DGMT(408.31,"AID",TYPE)) Q:TYPE=""!(FOUND) D
119 .S MTD=""
120 .F S MTD=$O(^DGMT(408.31,"AID",TYPE,DFN,MTD)) Q:MTD=""!(FOUND) D
121 ..S MIEN=""
122 ..F S MIEN=$O(^DGMT(408.31,"AID",TYPE,DFN,MTD,MIEN)) Q:MIEN=""!(FOUND) D
123 ...S ONODE=$G(^DGMT(408.31,MIEN,0))
124 ...S DATE=$P(ONODE,"^",25) ;Use IVM Verified Date
125 ...I DATE="" S DATE=$P(ONODE,"^",7) ;Use Completed Date
126 ...S COM=$G(^DGMT(408.31,MIEN,"C",1,0)) ;Comment
127 ...I DATE'="",COM[Z06COM,FRMDATE>(DATE-1),$G(^DGMT(408.31,MIEN,"PRIM")) S FOUND=1
128 Q FOUND
Note: See TracBrowser for help on using the repository browser.