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

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

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1DGENUPLB ;ALB/TDM - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ; 11/14/07 3:02pm
2 ;;5.3;REGISTRATION;**625,763**;Aug 13,1993;Build 9
3 ;
4EP N MSGARY
5 D CHECK
6 Q
7 ;
8CHECK ;Check for Rated Disability Changes
9 Q:'$D(DGELG)
10 N RDOCC,TMPARY,RD,RDOCC1,RDOCC2,RDFLG,RDNOD
11 ;
12 ;Change in Rated Disabilities
13 I $D(OLDELG("RATEDIS")) D
14 .S RDOCC=0 F S RDOCC=$O(OLDELG("RATEDIS",RDOCC)) Q:RDOCC="" D
15 ..S RD=$P(OLDELG("RATEDIS",RDOCC,"RD"),"^") Q:RD=""
16 ..S TMPARY(RD)=RDOCC
17 ;
18 I $D(DGELG("RATEDIS")) D
19 .S RDOCC=0 F S RDOCC=$O(DGELG("RATEDIS",RDOCC)) Q:RDOCC="" D
20 ..S RD=$P(DGELG("RATEDIS",RDOCC,"RD"),"^") Q:RD=""
21 ..S $P(TMPARY(RD),"^",2)=RDOCC
22 ;
23 I $D(TMPARY) D
24 .S RD=""
25 .F S RD=$O(TMPARY(RD)) Q:RD="" D
26 ..S RDOCC2=+$P(TMPARY(RD),"^",2) Q:'RDOCC2
27 ..S RDOCC1=+$P(TMPARY(RD),"^")
28 ..I 'RDOCC1 D STOR390 Q
29 ..S RDFLG=0
30 ..F RDNOD="RD","PER","RDSC","RDEXT","RDORIG","RDCURR" D Q:RDFLG
31 ...I $G(OLDELG("RATEDIS",RDOCC1,RDNOD))'=$G(DGELG("RATEDIS",RDOCC2,RDNOD)) D STOR390
32 Q
33 ;
34STOR390 ;Store Data in file# 390
35 S RDFLG=1
36 N DATA,DA
37 S DATA(.01)=$$NOW^XLFDT
38 S DATA(2)=DFN
39 S DATA(3)=DGELG("RATEDIS",RDOCC2,"RD")
40 S DATA(4)=DGELG("RATEDIS",RDOCC2,"PER")
41 S DATA(5)=DGELG("RATEDIS",RDOCC2,"RDEXT")
42 S DATA(6)=DGELG("RATEDIS",RDOCC2,"RDORIG")
43 S DATA(7)=DGELG("RATEDIS",RDOCC2,"RDCURR")
44 I '$$ADD^DGENDBS(390,,.DATA) S ERROR="FILEMAN FAILED TO ADD RATED DISABILITY UPLOAD AUDIT"
45 Q
Note: See TracBrowser for help on using the repository browser.