source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGENUPLB.m@ 975

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

revised back to 6/30/08 version
File size: 3.0 KB
RevLine 
[623]1DGENUPLB ;TDM - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ; 10/26/04 2:01pm
2 ;;5.3;REGISTRATION;**625**;Aug 13,1993
3 ;
4EP N MSGARY
5 D CHECK,SNDMSG
6 Q
7 ;
8CHECK ;Perform C&P and SC status checks and generate mailman messages
9 ;for MCCR eligibility & billing staff.
10 Q:'$D(OLDELG)
11 N RDOCC,TMPARY,RD,RDOCC1,RDOCC2,RDFLG
12 ;
13 ;Change in SC Indicator
14 I OLDELG("SC")'=DGELG("SC") D
15 .Q:(OLDELG("SC")="")&(DGELG("SC")="N")
16 .Q:(OLDELG("SC")="N")&(DGELG("SC")="")
17 .D ADDMSG^DGENUPL3(.MSGARY,"VETERAN SC INDICATOR CHANGED",1)
18 ;
19 ;SC% change to 50% or greater
20 I (OLDELG("SCPER")<50),(DGELG("SCPER")>49) D ADDMSG^DGENUPL3(.MSGARY,"VETERAN SC% CHANGED TO 50% OR GREATER",1)
21 ;
22 ;Change in VA Pension
23 I OLDELG("VAPEN")'=DGELG("VAPEN") D
24 .Q:(OLDELG("VAPEN")="")&(DGELG("VAPEN")="N")
25 .Q:(OLDELG("VAPEN")="N")&(DGELG("VAPEN")="")
26 .D ADDMSG^DGENUPL3(.MSGARY,"VETERAN VA PENSION CHANGED",1)
27 ;
28 ;Change in Rated Disabilities
29 I $D(OLDELG("RATEDIS")) D
30 .S RDOCC=0 F S RDOCC=$O(OLDELG("RATEDIS",RDOCC)) Q:RDOCC="" D
31 ..S RD=$P(OLDELG("RATEDIS",RDOCC,"RD"),"^") Q:RD=""
32 ..S TMPARY(RD)=RDOCC
33 ;
34 I $D(DGELG("RATEDIS")) D
35 .S RDOCC=0 F S RDOCC=$O(DGELG("RATEDIS",RDOCC)) Q:RDOCC="" D
36 ..S RD=$P(DGELG("RATEDIS",RDOCC,"RD"),"^") Q:RD=""
37 ..S $P(TMPARY(RD),"^",2)=RDOCC
38 ;
39 I $D(TMPARY) D
40 .S RD="",RDFLG=0
41 .F S RD=$O(TMPARY(RD)) Q:RD="" D
42 ..S RDOCC1=+$P(TMPARY(RD),"^"),RDOCC2=+$P(TMPARY(RD),"^",2)
43 ..I $G(OLDELG("RATEDIS",RDOCC1,"RD"))'=$G(DGELG("RATEDIS",RDOCC2,"RD")) S RDFLG=1
44 .I RDFLG D ADDMSG^DGENUPL3(.MSGARY,"VETERAN RATED DISABILITIES CHANGED",1)
45 Q
46 ;
47SNDMSG ;Description: Send messages generated above to the G.IB MEANS TEST
48 ;mail group.
49 ;
50 N TEXT,XMDUZ,XMTEXT,XMSUB,XMSTRIP,XMROU,XMY,XMZ,XMDF,COUNT
51 N HEADER,NSC,POW,TMPSTR,XMGROUP,ELIG,CD
52 ;
53 ;if there are no alerts, then quit
54 Q:'$D(MSGARY)
55 S HEADER="C&P Alert: ",XMDF="",(XMDUN,XMDUZ)="Registration Enrollment Module"
56 ;DGPAT("SSN") is built by the parser. DGPAT("NAME"),DGPAT("SEX"),DGPAT("DOB")(are merged into DGPAT from OLDPAT.
57 ;The checks below are to setup the DGPAT elements from OLDPAT if NOTIFY is called before the merge.
58 I '$D(DGPAT("NAME")) S DGPAT("NAME")=$G(OLDPAT("NAME"))
59 I '$D(DGPAT("SEX")) S DGPAT("SEX")=$G(OLDPAT("SEX"))
60 I '$D(DGPAT("DOB")) S DGPAT("DOB")=$G(OLDPAT("DOB"))
61 S TMPSTR=" ("_$E(DGPAT("NAME"),1,1)
62 S TMPSTR=TMPSTR_$E(DGPAT("SSN"),$L(DGPAT("SSN"))-3,1000)_")"
63 S XMSUB=HEADER_$E(DGPAT("NAME"),1,25)_TMPSTR
64 ;
65 ; send msg to mail group in IB SITE PARAMETERS (#350.9) file
66 S XMY("G.IB MEANS TEST")="" ; Means Test billing Group
67 ;
68 S XMTEXT="TEXT("
69 S TEXT(1)="The enrollment/eligibility upload produced the following alerts:"
70 S TEXT(2)=" "
71 S TEXT(3)="Patient Name : "_DGPAT("NAME")
72 S TEXT(4)="SSN : "_DGPAT("SSN")
73 S TEXT(5)="DOB : "_$$EXTERNAL^DILFD(2,$$FIELD^DGENPTA1("DOB"),"F",DGPAT("DOB"))
74 S TEXT(6)="SEX : "_$$EXTERNAL^DILFD(2,$$FIELD^DGENPTA1("SEX"),"F",DGPAT("SEX"))
75 S TEXT(7)=" "
76 ;
77 S TEXT(8)=" ** Alerts **"
78 S TEXT(9)=" "
79 S COUNT=0 F S COUNT=$O(MSGARY(COUNT)) Q:'COUNT S TEXT(10+COUNT)=COUNT_") "_MSGARY(COUNT)
80 ;
81 D ^XMD
82 Q
Note: See TracBrowser for help on using the repository browser.