- 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
