DGENUPLB.m

DGENUPLB ;ALB/TDM - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ; 11/14/07 3:02pm

 ;;5.3;PIMS;**625,1015,1016**;JUN 30, 2012;Build 20

 ;

EP N MSGARY

 D CHECK

 Q

 ;

CHECK ;Check for Rated Disability Changes

 Q:'$D(DGELG)

 N RDOCC,TMPARY,RD,RDOCC1,RDOCC2,RDFLG,RDNOD

 ;

 ;Change in Rated Disabilities

 I $D(OLDELG("RATEDIS")) D

 .S RDOCC=0 F  S RDOCC=$O(OLDELG("RATEDIS",RDOCC)) Q:RDOCC=""  D

 ..S RD=$P(OLDELG("RATEDIS",RDOCC,"RD"),"^") Q:RD=""

 ..S TMPARY(RD)=RDOCC

 ;

 I $D(DGELG("RATEDIS")) D

 .S RDOCC=0 F  S RDOCC=$O(DGELG("RATEDIS",RDOCC)) Q:RDOCC=""  D

 ..S RD=$P(DGELG("RATEDIS",RDOCC,"RD"),"^") Q:RD=""

 ..S $P(TMPARY(RD),"^",2)=RDOCC

 ;

 I $D(TMPARY) D

 .S RD=""

 .F  S RD=$O(TMPARY(RD)) Q:RD=""  D

 ..S RDOCC2=+$P(TMPARY(RD),"^",2) Q:'RDOCC2

 ..S RDOCC1=+$P(TMPARY(RD),"^")

 ..I 'RDOCC1 D STOR390 Q

 ..S RDFLG=0

 ..F RDNOD="RD","PER","RDSC","RDEXT","RDORIG","RDCURR" D  Q:RDFLG

 ...I $G(OLDELG("RATEDIS",RDOCC1,RDNOD))'=$G(DGELG("RATEDIS",RDOCC2,RDNOD)) D STOR390

 Q

 ;

STOR390 ;Store Data in file# 390

 S RDFLG=1

 N DATA,DA

 S DATA(.01)=$$NOW^XLFDT

 S DATA(2)=DFN

 S DATA(3)=DGELG("RATEDIS",RDOCC2,"RD")

 S DATA(4)=DGELG("RATEDIS",RDOCC2,"PER")

 S DATA(5)=DGELG("RATEDIS",RDOCC2,"RDEXT")

 S DATA(6)=DGELG("RATEDIS",RDOCC2,"RDORIG")

 S DATA(7)=DGELG("RATEDIS",RDOCC2,"RDCURR")

 I '$$ADD^DGENDBS(390,,.DATA) S ERROR="FILEMAN FAILED TO ADD RATED DISABILITY UPLOAD AUDIT"

 Q

DGENUPLB  ;ALB/TDM - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ; 11/14/07 3:02pm

 +1       ;;5.3;PIMS;**625,1015,1016**;JUN 30, 2012;Build 20

 +2       ;

EP         NEW MSGARY

 +1        DO CHECK

 +2        QUIT 

 +3       ;

CHECK     ;Check for Rated Disability Changes

 +1        IF '$DATA(DGELG)

               QUIT 

 +2        NEW RDOCC,TMPARY,RD,RDOCC1,RDOCC2,RDFLG,RDNOD

 +3       ;

 +4       ;Change in Rated Disabilities

 +5        IF $DATA(OLDELG("RATEDIS"))

               Begin DoDot:1

 +6                SET RDOCC=0

                   FOR 

                       SET RDOCC=$ORDER(OLDELG("RATEDIS",RDOCC))

                       IF RDOCC=""

                           QUIT 

                       Begin DoDot:2

 +7                        SET RD=$PIECE(OLDELG("RATEDIS",RDOCC,"RD"),"^")

                           IF RD=""

                               QUIT 

 +8                        SET TMPARY(RD)=RDOCC

                       End DoDot:2

               End DoDot:1

 +9       ;

 +10       IF $DATA(DGELG("RATEDIS"))

               Begin DoDot:1

 +11               SET RDOCC=0

                   FOR 

                       SET RDOCC=$ORDER(DGELG("RATEDIS",RDOCC))

                       IF RDOCC=""

                           QUIT 

                       Begin DoDot:2

 +12                       SET RD=$PIECE(DGELG("RATEDIS",RDOCC,"RD"),"^")

                           IF RD=""

                               QUIT 

 +13                       SET $PIECE(TMPARY(RD),"^",2)=RDOCC

                       End DoDot:2

               End DoDot:1

 +14      ;

 +15       IF $DATA(TMPARY)

               Begin DoDot:1

 +16               SET RD=""

 +17               FOR 

                       SET RD=$ORDER(TMPARY(RD))

                       IF RD=""

                           QUIT 

                       Begin DoDot:2

 +18                       SET RDOCC2=+$PIECE(TMPARY(RD),"^",2)

                           IF 'RDOCC2

                               QUIT 

 +19                       SET RDOCC1=+$PIECE(TMPARY(RD),"^")

 +20                       IF 'RDOCC1

                               DO STOR390

                               QUIT 

 +21                       SET RDFLG=0

 +22                       FOR RDNOD="RD","PER","RDSC","RDEXT","RDORIG","RDCURR"

                               Begin DoDot:3

 +23                               IF $GET(OLDELG("RATEDIS",RDOCC1,RDNOD))'=$GET(DGELG("RATEDIS",RDOCC2,RDNOD))

                                       DO STOR390

                               End DoDot:3

                               IF RDFLG

                                   QUIT 

                       End DoDot:2

               End DoDot:1

 +24       QUIT 

 +25      ;

STOR390   ;Store Data in file# 390

 +1        SET RDFLG=1

 +2        NEW DATA,DA

 +3        SET DATA(.01)=$$NOW^XLFDT

 +4        SET DATA(2)=DFN

 +5        SET DATA(3)=DGELG("RATEDIS",RDOCC2,"RD")

 +6        SET DATA(4)=DGELG("RATEDIS",RDOCC2,"PER")

 +7        SET DATA(5)=DGELG("RATEDIS",RDOCC2,"RDEXT")

 +8        SET DATA(6)=DGELG("RATEDIS",RDOCC2,"RDORIG")

 +9        SET DATA(7)=DGELG("RATEDIS",RDOCC2,"RDCURR")

 +10       IF '$$ADD^DGENDBS(390,,.DATA)

               SET ERROR="FILEMAN FAILED TO ADD RATED DISABILITY UPLOAD AUDIT"

 +11       QUIT