Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGENUPLB

DGENUPLB.m

Go to the documentation of this file.
  1. DGENUPLB ;ALB/TDM,KUM - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ;4/10/13 6:53pm
  1. ;;5.3;REGISTRATION;**625,763,842,871,952,977,1014,1082**;Aug 13,1993;Build 29
  1. ;
  1. EP N MSGARY
  1. D CHECK
  1. Q
  1. ;
  1. CHECK ;Check for Rated Disability Changes
  1. Q:'$D(DGELG)
  1. N RDOCC,TMPARY,RD,RDOCC1,RDOCC2,RDFLG,RDNOD
  1. ;
  1. ;Change in Rated Disabilities
  1. I $D(OLDELG("RATEDIS")) D
  1. .S RDOCC=0 F S RDOCC=$O(OLDELG("RATEDIS",RDOCC)) Q:RDOCC="" D
  1. ..S RD=$P(OLDELG("RATEDIS",RDOCC,"RD"),"^") Q:RD=""
  1. ..S TMPARY(RD)=RDOCC
  1. ;
  1. I $D(DGELG("RATEDIS")) D
  1. .S RDOCC=0 F S RDOCC=$O(DGELG("RATEDIS",RDOCC)) Q:RDOCC="" D
  1. ..S RD=$P(DGELG("RATEDIS",RDOCC,"RD"),"^") Q:RD=""
  1. ..S $P(TMPARY(RD),"^",2)=RDOCC
  1. ;
  1. I $D(TMPARY) D
  1. .S RD=""
  1. .F S RD=$O(TMPARY(RD)) Q:RD="" D
  1. ..S RDOCC2=+$P(TMPARY(RD),"^",2) Q:'RDOCC2
  1. ..S RDOCC1=+$P(TMPARY(RD),"^")
  1. ..I 'RDOCC1 D STOR390 Q
  1. ..S RDFLG=0
  1. ..F RDNOD="RD","PER","RDSC","RDEXT","RDORIG","RDCURR" D Q:RDFLG
  1. ...I $G(OLDELG("RATEDIS",RDOCC1,RDNOD))'=$G(DGELG("RATEDIS",RDOCC2,RDNOD)) D STOR390
  1. Q
  1. ;
  1. STOR390 ;Store Data in file# 390
  1. S RDFLG=1
  1. N DATA,DA
  1. S DATA(.01)=$$NOW^XLFDT
  1. S DATA(2)=DFN
  1. S DATA(3)=DGELG("RATEDIS",RDOCC2,"RD")
  1. S DATA(4)=DGELG("RATEDIS",RDOCC2,"PER")
  1. S DATA(5)=DGELG("RATEDIS",RDOCC2,"RDEXT")
  1. S DATA(6)=DGELG("RATEDIS",RDOCC2,"RDORIG")
  1. S DATA(7)=DGELG("RATEDIS",RDOCC2,"RDCURR")
  1. I '$$ADD^DGENDBS(390,,.DATA) S ERROR="FILEMAN FAILED TO ADD RATED DISABILITY UPLOAD AUDIT"
  1. Q
  1. ;
  1. ZE2 ; Process ZE2 segment
  1. N HL7REP,HL7SC,SUB
  1. S HL7SC=$E(HLECH,1)
  1. S DGPAT("PENAEFDT")=$$CONVERT^DGENUPL1($P(SEG(1),HL7SC),"DATE",.ERROR)
  1. I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZE2 SEGMENT , SEQ 1-1",.ERRCOUNT) Q
  1. S DGPAT("PENTRMDT")=$$CONVERT^DGENUPL1($P(SEG(1),HL7SC,2),"DATE",.ERROR)
  1. I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZE2 SEGMENT , SEQ 1-2",.ERRCOUNT) Q
  1. S DGPAT("PENAREAS")=$$CONVERT^DGENUPL1($P(SEG(2),HL7SC),"PENSIONCD",.ERRCOUNT)
  1. I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZE2 SEGMENT , SEQ 2",.ERRCOUNT) Q
  1. F HL7REP=1:1:4 D Q:ERROR
  1. .Q:$P($P(SEG(3),"|",HL7REP),HL7SC)=""
  1. .S SUB="PENTRMR"_HL7REP
  1. .S DGPAT(SUB)=$$CONVERT^DGENUPL1($P($P(SEG(3),"|",HL7REP),HL7SC),"PENSIONCD",.ERRCOUNT)
  1. .I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZE2 SEGMENT , SEQ 3",.ERRCOUNT)
  1. ;
  1. ; Convert to deletion indicator if null
  1. N SUB F SUB="PENAEFDT","PENTRMDT","PENAREAS","PENTRMR1","PENTRMR2","PENTRMR3","PENTRMR4" S:$G(DGPAT(SUB))="" DGPAT(SUB)="@"
  1. Q
  1. ;
  1. ZHF ; DG*5.3*1082 - Process ZHF segment
  1. S ERROR=0
  1. S DGZHF("PPCATEGORY")=$$CONVERT^DGENUPL1(SEG(1))
  1. I DGZHF("PPCATEGORY")'="" D CHK^DIE(33.12,.02,,DGZHF("PPCATEGORY"),.ERROR) I ERROR="^" S ERROR=1
  1. I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZHF SEGMENT , SEQ 1",.ERRCOUNT) Q
  1. S DGZHF("PPCATCHGDT")=$$CONVERT^DGENUPL1(SEG(2),"TS",.ERROR)
  1. I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZHF SEGMENT , SEQ 2",.ERRCOUNT) Q
  1. Q
  1. ;
  1. ZHP ;Process ZHP segment
  1. N CTR
  1. S CTR=$O(DGHBP(""),-1)+1
  1. S $P(DGHBP(CTR),U)=$$CONVERT^DGENUPL1(SEG(2),"HBP",.ERROR)
  1. I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZHP SEGMENT , SEQ 2",.ERRCOUNT) Q
  1. S $P(DGHBP(CTR),U,2)=$$CONVERT^DGENUPL1(SEG(3),"TS",.ERROR)
  1. I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZHP SEGMENT , SEQ 3",.ERRCOUNT) Q
  1. S $P(DGHBP(CTR),U,3)=.5 ;Postmaster
  1. S $P(DGHBP(CTR),U,4)=$$CONVERT^DGENUPL1(SEG(5),"INSTITUTION",.ERROR)
  1. I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZHP SEGMENT , SEQ 5",.ERRCOUNT) Q
  1. S $P(DGHBP(CTR),U,5)=$$CONVERT^DGENUPL1(SEG(4),,.ERROR)
  1. I (($P(DGHBP(CTR),U,5)'="V")&($P(DGHBP(CTR),U,5)'="E")) S ERROR=1
  1. I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZHP SEGMENT , SEQ 4",.ERRCOUNT) Q
  1. Q
  1. ;
  1. ZTE ; process ZTE segment DG*5.3*952
  1. N CHKFLG,CNT,EDITTS,ENTBY,FCLTY,ORIGTS,QFLG,SUBDT,TYPE
  1. S TYPE=$$CONVERT^DGENUPL1(SEG(4),,.ERROR) I "^A^D^P^"'[(U_TYPE_U) S ERROR=1
  1. I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"Invalid value in ZTE segment, field 4",.ERRCOUNT) Q
  1. ; fields common to all 3 request types
  1. S SUBDT=$$CONVERT^DGENUPL1(SEG(2),"DATE",.ERROR)
  1. I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"Invalid value in ZTE segment, field 2",.ERRCOUNT) Q
  1. S CHKFLG=$S(SUBDT="@":0,1:1)
  1. S ORIGTS=$$CONVERT^DGENUPL1(SEG(3),"TS",.ERROR)
  1. I ERROR!(ORIGTS="") D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"Invalid value in ZTE segment, field 3",.ERRCOUNT) Q
  1. S EDITTS=$$CONVERT^DGENUPL1(SEG(5),"TS",.ERROR)
  1. I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"Invalid value in ZTE segment, field 5",.ERRCOUNT) Q
  1. S ENTBY=$$GET1^DIQ(200,".5,",.01) ; DG*5.3*977 OTH-EXT set user to POSTMASTER instead of value from ZTE.6
  1. S FCLTY=$$CONVERT^DGENUPL1(SEG(7),"INSTITUTION",.ERROR)
  1. I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"Invalid value in ZTE segment, field 7",.ERRCOUNT) Q
  1. S QFLG=0
  1. I TYPE="P" D Q:QFLG
  1. .I $G(DGOTH("P"))'="" S ERROR=1
  1. .I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"Invalid ZTE segment, only one pending request is allowed.",.ERRCOUNT) S QFLG=1 Q
  1. .S DGOTH("P")="1"_U_SUBDT_U_ENTBY_U_FCLTY_U_ORIGTS_U_EDITTS
  1. .Q
  1. I TYPE="D" D Q:QFLG
  1. .S CNT=$O(DGOTH("D",""),-1)+1
  1. .S DGOTH("D",CNT)=SUBDT
  1. .S $P(DGOTH("D",CNT),U,2)=$$CONVERT^DGENUPL1(SEG(13),,.ERROR)
  1. .I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"Invalid value in ZTE segment, field 13",.ERRCOUNT) S QFLG=1 Q
  1. .S DGOTH("D",CNT)=DGOTH("D",CNT)_U_ENTBY_U_FCLTY_U_ORIGTS_U_EDITTS
  1. .Q
  1. I TYPE="A" D Q:QFLG
  1. .S CNT=$O(DGOTH("A",""),-1)+1
  1. .S DGOTH("A",CNT)=$$CONVERT^DGENUPL1(SEG(8),,.ERROR)
  1. .I CHKFLG,+DGOTH("A",CNT)'>0 S ERROR=1
  1. .I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"Invalid value in ZTE segment, field 8",.ERRCOUNT) S QFLG=1 Q
  1. .S $P(DGOTH("A",CNT),U,2)=$$CONVERT^DGENUPL1(SEG(9),,.ERROR)
  1. .I CHKFLG,+$P(DGOTH("A",CNT),U,2)'>0 S ERROR=1
  1. .I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"Invalid value in ZTE segment, field 9",.ERRCOUNT) S QFLG=1 Q
  1. .S $P(DGOTH("A",CNT),U,3)=SUBDT
  1. .S $P(DGOTH("A",CNT),U,4)=$$CONVERT^DGENUPL1(SEG(11),,.ERROR)
  1. .I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"Invalid value in ZTE segment, field 11",.ERRCOUNT) S QFLG=1 Q
  1. .S $P(DGOTH("A",CNT),U,5)=$$CONVERT^DGENUPL1(SEG(10),"DATE",.ERROR)
  1. .I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"Invalid value in ZTE segment, field 10",.ERRCOUNT) S QFLG=1 Q
  1. .S $P(DGOTH("A",CNT),U,6)=$$CONVERT^DGENUPL1(SEG(12),"DATE",.ERROR)
  1. .I CHKFLG,$P(DGOTH("A",CNT),U,6)="" S ERROR=1
  1. .I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"Invalid value in ZTE segment, field 12",.ERRCOUNT) S QFLG=1 Q
  1. .S DGOTH("A",CNT)=DGOTH("A",CNT)_U_ENTBY_U_FCLTY_U_ORIGTS_U_EDITTS
  1. .Q
  1. Q
  1. ZCE ; process ZCE segment DG*5.3*1014
  1. N DGCPCD,DGEFDT,DGEDDT,DGLUTS
  1. S DGCPCD=$$CONVERT^DGENUPL1(SEG(2),,.ERROR) I "^A^C^I^T^"'[(U_DGCPCD_U) S ERROR=1
  1. I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"Invalid value in ZCE segment, field 2",.ERRCOUNT) Q
  1. S DGEFDT=$$CONVERT^DGENUPL1(SEG(3),"DATE",.ERROR)
  1. I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"Invalid value in ZCE segment, field 3",.ERRCOUNT) Q
  1. S DGEDDT=$$CONVERT^DGENUPL1(SEG(4),"DATE",.ERROR)
  1. I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"Invalid value in ZCE segment, field 4",.ERRCOUNT) Q
  1. S DGLUTS=$$CONVERT^DGENUPL1(SEG(5),"TS",.ERROR)
  1. I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"Invalid value in ZCE segment, field 5",.ERRCOUNT) Q
  1. S DGCCPC=DGCCPC+1
  1. S DGCCPG(DGCCPC)=DGCPCD_U_DGEFDT_U_DGEDDT_U_DGLUTS
  1. Q