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

DGENUPL7.m

Go to the documentation of this file. 
  1. DGENUPL7 ;ISA/KWP,CKN,TMK,TDM,LBD,HM,KUM - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ;9/12/20 5:48pm
  1.  ;;5.3;REGISTRATION;**232,367,397,417,379,431,513,628,673,653,742,688,797,871,972,952,977,993,1014,1027,1045,1082,1090,1111**;Aug 13,1993;Build 18
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ;Phase II split from DGENUPL
  1. Z11(MSGIEN,MSGID,CURLINE,DFN,ERRCOUNT) ;
  1.  ;Description:  This is used to process a single ORU~Z11 or ORF~Z11 msg. 
  1.  ;Input:
  1.  ;  MSGIEN - the internal entry number of the HL7 message in the
  1.  ;      HL7 MESSAGE TEXT file (772)
  1.  ;  MSGID -message control id of HL7 msg in the MSH segment
  1.  ;  CURLINE - the subscript of the MSH segment of the current message (pass by reference)
  1.  ;  DFN - identifies the patient, is the ien of a record in the PATIENT file.
  1.  ;  ERRCOUNT - is a count of the number of messages in the batch that can not be processed (pass by reference)
  1.  ;
  1.  ;Output:
  1.  ;  CURLINE - upon leaving the procedure this parameter should be set to the end of the current message. (pass by reference)
  1.  ;  ERRCOUNT - set to count of messages that were not processed due to errors encountered  (pass by reference)
  1.  ;
  1.  N DGELG,DGENR,DGPAT,DGCDIS,DGOEIF,ERROR,ERRMSG,MSGS,DGELGSUB,DGENUPLD,DGCON,DGNMSE,DGCCPG,DGSUB,DGFDA,DGERR,DGIENS
  1.  N DGNEWVAL,DIV,SUB,OLDELG,OLDPAT,OLDDCDIS,OLDEIF,DGSEC,OLDSEC,DGNTR,DGMST,DGPHINC,DGHBP,DGOTH,DGSUB,DGCOVF,DGESCO,DGCOV
  1.  N DGELCV,DGOAPP,DGZHF
  1.  ;
  1.  ;some process is killing these HL7 variables, so need to protect them
  1.  S SUB=HLFS
  1.  S DIV=HLECH
  1.  N HLDA,HLDAN,HLDAP,HLDT,HLDT1,HLECH,HLFS,HLNDAP,HLNDAP0,HLPID,HLQ,HLVER,HLERR,HLMTN,HLSDT
  1.  S HLFS=SUB
  1.  S HLECH=DIV
  1.  S HLQ=""""""
  1.  K DIV,SUB
  1.  ;DG*5.3*1090 - Kill ^TMP global Combat Vet Elig End Date Source
  1.  K ^TMP("DGCVE",$J,"COMBAT VET ELIG END DATE SOURCE",DFN)
  1.  ;
  1.  ;drops out of block on error
  1.  D
  1.  .;DG*5.3*1082 - Add ZHF Parsing to load DGZHF array
  1.  .Q:'$$PARSE^DGENUPL1(MSGIEN,MSGID,.CURLINE,.ERRCOUNT,.DGPAT,.DGELG,.DGENR,.DGCDIS,.DGOEIF,.DGSEC,.DGNTR,.DGMST,.DGNMSE,.DGHBP,.DGOTH,.DGZHF)
  1.  .; DG*5.3*1014 - Capture Z11 eligibilities
  1.  .M DGELCV=DGELG
  1.  .D GETLOCKS^DGENUPL5(DFN)
  1.  .;
  1.  .;Used by cross-references to determine if an upload is in progress.
  1.  .S DGENUPLD="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS"
  1.  .;
  1.  .;Update the PATIENT, ELIGIBILITY, CATASTROPHIC DISABILITY objects in memory
  1.  .Q:'$$UOBJECTS^DGENUPL4(DFN,.DGPAT,.DGELG,.DGCDIS,.DGOEIF,MSGID,.ERRCOUNT,.MSGS,.OLDPAT,.OLDELG,.OLDCDIS,.OLDEIF)
  1.  .;DG*5.3*1014 - Delete Vista secondary eligibilities from DGELG array
  1.  .S DGSUB=0 F  S DGSUB=$O(DGELG("ELIG","CODE",DGSUB)) Q:'DGSUB  D
  1.  ..I '$D(DGELCV("ELIG","CODE",DGSUB)) K DGELG("ELIG","CODE",DGSUB)
  1.  .;
  1.  .S ERROR=0
  1.  .;if the msg contains patient security, process it
  1.  .I $D(DGSEC) D  Q:ERROR
  1.  ..S DGSEC("DFN")=DFN
  1.  ..S DGSEC("USER")=.5
  1.  ..I DGSEC("LEVEL")'="" D
  1.  ...I DGSEC("DATETIME")="" S DGSEC("DATETIME")=$$NOW^XLFDT ;DG*5.3*653 
  1.  ..;
  1.  ..; check consistency of patient security record
  1.  ..I '$$CHECK^DGENSEC(.DGSEC,.ERRMSG) D  Q
  1.  ...S ERROR=1
  1.  ...D ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),ERRMSG,.ERRCOUNT)
  1.  ..;
  1.  ..; upload patient security, consistency checks passed
  1.  ..D SECUPLD^DGENUPL5(DFN,.DGSEC,.OLDSEC)
  1.  .;
  1.  .; KUM - DG*5.3*1014 - BEGIN
  1.  .; Upload Community Care Program Data to Patient file (#2)
  1.  .;
  1.  .; End date all CCPs and Set Archive flag if COV is removed from eligibilities
  1.  .S DGCOV=$$FIND1^DIC(8,"","B","COLLATERAL OF VET")
  1.  .S DGCOVF=""
  1.  .S DGESCO=""
  1.  .I $$GET1^DIQ(2,DFN_",",".361","I")=$G(DGCOV) S DGCOVF="Y"
  1.  .S DGSUB=0 F  S DGSUB=$O(^DPT(DFN,"E",DGSUB)) Q:'DGSUB  D
  1.  ..I +$G(^DPT(DFN,"E",DGSUB,0))=$G(DGCOV) S DGCOVF="Y"
  1.  .I DGELCV("ELIG","CODE")=$G(DGCOV) S DGESCO="Y"
  1.  .S DGSUB=0 F  S DGSUB=$O(DGELCV("ELIG","CODE",DGSUB)) Q:'DGSUB  D
  1.  ..I DGSUB=$G(DGCOV) S DGESCO="Y"
  1.  .I DGCOVF="Y",DGESCO'="Y" D ARCHALL^DGRP1152U(DFN)
  1.  .;
  1.  .; Allow moving of cov from Primary to Other
  1.  .; Removing COV from patient eligibilities is not allowed if there are active CCPs
  1.  .; But uisng Z11, moving COV from primary to Other eligibilities is allowed, in this Case, bypassing the Check
  1.  .I DGELG("ELIG","CODE")'=$G(DGCOV),$$GET1^DIQ(2,DFN_",",".361","I")=$G(DGCOV),DGESCO="Y" D
  1.  ..S $P(^DPT(DFN,.36),"^",1)=""
  1.  .;
  1.  .S DGSUB=""
  1.  .F  S DGSUB=$O(DGCCPG(DGSUB)) Q:DGSUB=""  D
  1.  ..N DGMAT,DGPGCD,DGEFDT,DGEDDT,DGLUTS,DGZ,IENS,DGPGC1,DGEFD1
  1.  ..S DGMAT="N"
  1.  ..S DGPGCD=$P(DGCCPG(DGSUB),"^",1)
  1.  ..S DGEFDT=$P(DGCCPG(DGSUB),"^",2)
  1.  ..S DGEDDT=$P(DGCCPG(DGSUB),"^",3)
  1.  ..I $G(DGEDDT)="@" S DGEDDT=""
  1.  ..I $G(DGEDDT)="" S DGEDDT=""
  1.  ..S DGLUTS=$P(DGCCPG(DGSUB),"^",4)
  1.  ..S DGZ=0 F  S DGZ=$O(^DPT(DFN,5,"AC",$G(DGEFDT),DGZ)) Q:'DGZ  D
  1.  ...S IENS=DGZ_","_DFN_","
  1.  ...I $$GET1^DIQ(2.191,IENS,4,"I")'=1 D
  1.  ....S DGPGC1=$$GET1^DIQ(2.191,IENS,1,"I")
  1.  ....S DGEFD1=$$GET1^DIQ(2.191,IENS,2,"I")
  1.  ....I ($G(DGPGCD)=$G(DGPGC1)),($G(DGEFDT)=$G(DGEFD1)) S DGMAT="Y" D CCCUPD
  1.  ..I DGMAT'="Y" D CCCADD
  1.  .Q:ERROR
  1.  .; KUM - DG*5.3*1014 - END
  1.  .; 
  1.  .;if the msg has an enrollment process it
  1.  .I DGENR("STATUS")!DGENR("APP") D  Q:ERROR
  1.  ..N DGENRYN,DGSTS
  1.  ..S DGENRYN=""
  1.  ..S DGSTS=DGENR("STATUS")
  1.  ..I DGSTS=25 S DGENRYN=0 ;DG*5.3*993
  1.  ..I DGSTS'=25,'$$PREEXIST^DGREG(DFN) S DGENRYN=1
  1.  ..;use $$PRIORITY to get the eligibility data used to compute priority
  1.  ..I $$PRIORITY^DGENELA4(DFN,.DGELG,.DGELGSUB,DGENR("DATE"),DGENR("APP"),$G(DGENRYN)) ;DG*5.3*993 Added DGENRYN REGISTRATION ONLY
  1.  ..;
  1.  ..;store the eligibility data in the enrollment record and other missing fields
  1.  ..M DGENR("ELIG")=DGELGSUB
  1.  ..S DGENR("ELIG","OTHTYPE")=$G(DGELG("OTHTYPE")) ; DG*5.3*952
  1.  ..S DGENR("DFN")=DFN
  1.  ..S DGENR("PRIORREC")=""
  1.  ..S DGENR("USER")=.5
  1.  ..S DGENR("DATETIME")=$$NOW^XLFDT
  1.  ..;
  1.  ..;Allow null overwrites of Ineligible data (Ineligible Project):
  1.  ..I $D(DGENR("DATE")),DGENR("DATE")="" S DGENR("DATE")="@"
  1.  ..I $D(DGENR("FACREC")),DGENR("FACREC")="" S DGENR("FACREC")="@"
  1.  ..;
  1.  ..;check the consistency of the enrollment record
  1.  ..I '$$CHECK^DGENA3(.DGENR,.DGPAT,.ERRMSG) D  Q
  1.  ...S ERROR=1
  1.  ...D ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),ERRMSG,.ERRCOUNT)
  1.  ..;
  1.  ..;DG5.3*1027 - Do not reject Z11 when VistA stored YES for DO YOU WISH TO ENROLL and receive NO from HEC
  1.  ..; DG*5.3*993 - BEGIN
  1.  ..;Find patient's current enrollment record
  1.  ..;N DGENRIEN,DGENRYN
  1.  ..;S DGENRIEN=""
  1.  ..;S DGENRYN=""
  1.  ..;S DGENRIEN=$$FINDCUR^DGENA(DFN)
  1.  ..;I DGENRIEN S:$G(DGENRYN)="" DGENRYN=$$GET1^DIQ(27.11,DGENRIEN_",",.14,"I") ;DG*5.3*993 Added REGISTRATION ONLY
  1.  ..;I DGENRYN=1,DGENR("PTAPPLIED")=0,DGPAT("VETERAN")="Y" D Q
  1.  ..;S ERROR=1
  1.  ..;S ERRMSG="Veteran has applied for enrollment. Do You Wish to Enroll cannot be No."
  1.  ..;D ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),ERRMSG,.ERRCOUNT)
  1.  ..;
  1.  ..; DG*5.3*993 - END
  1.  ..;DG*5.3*1027 - END
  1.  ..;
  1.  ..; removed EGT consistency check with DG*5.3*628
  1.  ..;Phase II EGT consistency checks (SRS 6.5.1.3)
  1.  ..; DG*5.3*1111 - ENROLLMENT STATUS (file #27.15) entries of REJECTED renamed to DEFERRED.  Comment below modified
  1.  ..;Only do the EGT consistency checks for Deferred-Fiscal Year (11),Deferred-Mid Cycle (12),Deferred-Stop enrolling new apps (13),Deferred-Initial App by VAMC (14),Deferred below EGT threshold (22)
  1.  ..;I "^11^12^13^14^22^"[("^"_DGENR("STATUS")_"^"),$$ABOVE^DGENEGT1(DGENR("DFN"),DGENR("PRIORITY"),DGENR("SUBGRP"),"","",1) D  Q
  1.  ..;.S ERROR=1
  1.  ..;.S ERRMSG="THE ENROLLMENT RECORD DID NOT PASS THE EGT CONSISTENCY CHECKS."
  1.  ..;.D ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),ERRMSG,.ERRCOUNT)
  1.  ..;
  1.  ..;Allow null overwrites for Ineligible vets (Ineligible Project):
  1.  ..I $G(DGPAT("INELDATE"))'="" S (DGENR("PRIORITY"),DGENR("SUBGRP"))=""
  1.  ..I DGENR("DATE")="@" S DGENR("DATE")=""
  1.  ..I DGENR("FACREC")="@" S DGENR("FACREC")=""
  1.  ..;
  1.  ..D ENRUPLD^DGENUPL8(.DGENR,.DGPAT)
  1.  .;
  1.  .;Store the PATIENT, ELIGIBILITY, & CAT. DISB. objects
  1.  .I $$STORE^DGENPTA1(.DGPAT,,1)
  1.  .I $$STORE^DGENELA1(.DGELG,.DGPAT,.DGCDIS,,1)
  1.  .I $G(DGCDIS("VCD"))'="",$$STORE^DGENCDA2(DFN,.DGCDIS) ;checks first if there is catastrophic disability information
  1.  .; store OTH data
  1.  .D OTHUPLD^DGENUPL8(DFN,.DGOTH,$G(DGPAT("SSN")),$G(DGELG("ELIG","CODE"))) ; DG*5.3*952
  1.  .;
  1.  .;Call PIMS api to file NTR data.
  1.  .I $D(DGNTR),$$ENRUPD^DGNTAPI1(DFN,.DGNTR)
  1.  .;
  1.  .;Call PIMS api to file MST data.
  1.  .I DGMST("MSTSTAT")'="",DGMST("MSTDT")'="",DGMST("MSTST")'="" D
  1.  ..I $$NEWSTAT^DGMSTAPI(DFN,DGMST("MSTSTAT"),DGMST("MSTDT"),".5",DGMST("MSTST"),0)
  1.  ..Q
  1.  .; create new entry in sub-file 33.02
  1.  .D CRTEELCH^DGOTHEL(DFN,$$HASENTRY^DGOTHD2(DFN),$G(DGELG("OTHTS"))) ; DG*5.3*977 OTH-EXT - moved after MST data update
  1.  .;
  1.  .;Since HEC is authoritative source, If no OEF/OIF data in Z11, set count to 0 so existing data in VistA will be deleted.
  1.  .I '$D(DGOEIF) S DGOEIF("COUNT")=0
  1.  .;Call PIMS api to file OEF/OIF data.
  1.  .I $D(DGOEIF) D OEIFUPD^DGCLAPI1(DFN,.DGOEIF)
  1.  .;
  1.  .;File the Military Service Episode (MSE) data (DG*5.3*797)
  1.  .I $D(DGNMSE) D UPDMSE^DGMSEUTL(DFN,.DGNMSE)
  1.  .;
  1.  .;File the Health Benefit Plan (HBP) data
  1.  .D HL7UPD^DGHBPUTL(DFN,.DGHBP,MSHDT)
  1.  .;DG*5.3*1082 - File the Health Factor Segment (ZHF) data
  1.  .D ZHFUPD
  1.  .;
  1.  .;if the current enrollment is a local then log patient for transmission
  1.  .;DG*5.3*1045 - Don't trigger Z07 if source is VAMC 
  1.  .;I $$SOURCE^DGENA(DFN)=1!$G(DGPHINC) K DGENUPLD,DGPHINC D EVENT^IVMPLOG(DFN)
  1.  .I $G(DGPHINC) K DGENUPLD,DGPHINC D EVENT^IVMPLOG(DFN)
  1.  .;
  1.  .;create the audit trail
  1.  .K OLDPAT("MOH"),DGPAT("MOH") ;remove MOH from audit demographics report DG*5.3*972 HM
  1.  .I $$AUDIT^DGENUPA1(,MSGID,.OLDPAT,.DGPAT,.OLDELG,.DGELG,.OLDCDIS,.DGCDIS,.DGSEC,.OLDSEC)
  1.  .;send notifications
  1.  .D NOTIFY^DGENUPL3(.DGPAT,.MSGS)
  1.  .;
  1.  .;invoke registration consistency checker
  1.  .D REGCHECK^DGENUPL2(DFN)
  1.  ;
  1.  D UNLOCK^DGENUPL5(DFN)
  1.  ;DG*5.3*1090 - Kill ^TMP global Combat Vet Elig End Date Source
  1.  K ^TMP("DGCVE",$J,"COMBAT VET ELIG END DATE SOURCE",DFN)
  1.  Q
  1. CCCADD ; Add new entry to #2.191
  1.  N DGERR,DGIENS,DGFDA
  1.  S DGERR=0
  1.  S DGIENS=DFN_","
  1.  S DGIENS="+1,"_DGIENS
  1.  S DGFDA(2.191,DGIENS,.01)=$G(DGLUTS)
  1.  S DGFDA(2.191,DGIENS,1)=$G(DGPGCD)
  1.  S DGFDA(2.191,DGIENS,2)=$G(DGEFDT)
  1.  S DGFDA(2.191,DGIENS,3)=$G(DGEDDT)
  1.  D UPDATE^DIE("","DGFDA","","DGERR")
  1.  I DGERR D
  1.  .S ERROR=1
  1.  .D ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),$G(DGERR("DIERR",1,"TEXT",1)),.ERRCOUNT)
  1.  Q
  1. CCCUPD ; Update entry in #2.191
  1.  N DGFDA,DGERR,DGIENS,DGTMTS
  1.  S DGERR=0
  1.  S DGIENS=IENS
  1.  S DGTMTS=+$$GET1^DIQ(2.191,DGIENS,.01,"I")
  1.  I $G(DGLUTS)>$G(DGTMTS) D
  1.  .S DGFDA(2.191,DGIENS,.01)=$G(DGLUTS)
  1.  .S DGFDA(2.191,DGIENS,3)=$G(DGEDDT)
  1.  .S DGFDA(2.191,DGIENS,4)=0
  1.  .D FILE^DIE("","DGFDA","DGERR")
  1.  .I DGERR D
  1.  ..S ERROR=1
  1.  ..D ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),$G(DGERR("DIERR",1,"TEXT",1)),.ERRCOUNT)
  1.  Q
  1. ZHFUPD ; DG*5.3*1082 - Update database with the ZHF data
  1.  ; a date is always expected when updating.
  1.  I $G(DGZHF("PPCATCHGDT"))'="" D
  1.  .; Update Presumptive Psychosis Category (#.5601) field in the Patient (#2) file, and the Presumptive Psychosis Category Change (#33.1) file.
  1.  .I '$$PT^DGPPSYCH(DFN,DGZHF("PPCATEGORY"),DGZHF("PPCATCHGDT")) D
  1.  ..S ERRMSG="FILEMAN FAILED TO UPDATE PRESUMPTIVE PSYCHOSIS CATEGORY"
  1.  ..S ERROR=1
  1.  ..D ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),$G(ERRMSG),.ERRCOUNT) Q
  1.  Q