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

DGENUPL3.m

Go to the documentation of this file. 
  1. DGENUPL3 ;ALB/CJM,ISA/KWP,AEG,BRM,ERC,CKN,BAJ,PHH,TDM,LBD - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ; 6/4/09 4:09pm
  1.  ;;5.3;PIMS;**147,230,232,377,404,451,653,688,1015,1016**;JUN 30, 2012;Build 20
  1.  ;
  1.  ;
  1. ADDMSG(MSGS,MESSAGE,TOHEC) ;
  1.  ;Description: Used to add a message to an array of messages to be sent.
  1.  ;
  1.  ;Input:
  1.  ;  MSGS - the array to store the message (pass by reference)
  1.  ;  MESSAGE - the message to store
  1.  ;  TOHEC - a flag, if set to 1 it means that HEC should also receive notification
  1.  ;
  1.  ;Output: none
  1.  ;
  1.  I MESSAGE["DATE OF DEATH" Q
  1.  S MSGS(0)=($G(MSGS(0))+1)
  1.  S MSGS(MSGS(0))=MESSAGE
  1.  I ($G(TOHEC)=1) S MSGS("HEC")=1
  1.  Q
  1.  ;
  1.  ;
  1. NOTIFY(DGPAT,MSGS) ;
  1.  ;Description: This is used to send a message to the local mail group
  1.  ;defined by the MAS Parameter ELIGIBILITY UPLOAD MAIL GROUP.The
  1.  ;notification is to be used when specific problems or conditions
  1.  ;regarding the upload of the enrollment or eligibility data.
  1.  ;
  1.  ;Input: 
  1.  ;  OLDPAT -used if the DGPAT elements have not been built
  1.  ;  DGPAT - patient array (pass by reference)
  1.  ;  MSGS - the an array of messages that should be included in the
  1.  ;         notification (pass by reference). If MSGS("HEC")=1
  1.  ;         it means that HEC should also receive notification.
  1.  ;
  1.  ;Output:   none
  1.  ;
  1.  N TEXT,XMDUZ,XMTEXT,XMSUB,XMSTRIP,XMROU,XMY,XMZ,XMDF,COUNT
  1.  N HEADER,NSC,POW,TMPSTR,MAILGRP,ELIG,CD
  1.  ;
  1.  ;if there are no alerts, then quit
  1.  Q:'$G(MSGS(0))
  1.  ;
  1.  ;Get reason for alert.  If there is more than one reason decide which 
  1.  ;reason to display.  'NON-SERVICE' alerts have a higher priority than
  1.  ;other alerts and are therefore displayed before other alerts in the 
  1.  ;subject line, followed by 'POW' alerts in priority.
  1.  S (ELIG,NSC,POW,CD)=0
  1.  S COUNT=0 F  S COUNT=$O(MSGS(COUNT)) Q:'COUNT!NSC  D
  1.  .I MSGS(COUNT)["PREVIOUSLY ELIGIBLE" S ELIG=1 Q
  1.  .I MSGS(COUNT)["NON-SERVICE" S NSC=1 Q
  1.  .I MSGS(COUNT)["POW" S POW=1 Q
  1.  .I MSGS(COUNT)["CD EVALUATION" S CD=1 Q
  1.  .S HEADER=MSGS(COUNT)
  1.  .Q
  1.  D
  1.  .I ELIG S HEADER="Ineligibility Alert: " Q
  1.  .I NSC S HEADER="NSC Alert: " Q
  1.  .I POW&'NSC S HEADER="POW Alert: " Q
  1.  .I CD S HEADER="CD Alert: " Q
  1.  .Q
  1.  ;
  1.  S XMDF=""
  1.  S (XMDUN,XMDUZ)="Registration Enrollment Module"
  1.  ;Phase II Re-Enrollment
  1.  ;DGPAT("SSN") is built by the parser.  DGPAT("NAME"),DGPAT("SEX"),DGPAT("DOB")(are merged into DGPAT from OLDPAT.
  1.  ;The checks below are to setup the DGPAT elements from OLDPAT if NOTIFY is called before the merge. 
  1.  I '$D(DGPAT("NAME")) S DGPAT("NAME")=$G(OLDPAT("NAME"))
  1.  I '$D(DGPAT("SEX")) S DGPAT("SEX")=$G(OLDPAT("SEX"))
  1.  I '$D(DGPAT("DOB")) S DGPAT("DOB")=$G(OLDPAT("DOB"))
  1.  S TMPSTR=" ("_$E(DGPAT("NAME"),1,1)
  1.  S TMPSTR=TMPSTR_$E(DGPAT("SSN"),$L(DGPAT("SSN"))-3,1000)_")"
  1.  S XMSUB=$E(HEADER,1,30)_$E(DGPAT("NAME"),1,25)_TMPSTR
  1.  ;
  1.  ; send msg to local mail group specified in IVM SITE PARAMETER file
  1.  S MAILGRP=+$P($G(^IVM(301.9,1,0)),"^",9)
  1.  S MAILGRP=$$EXTERNAL^DILFD(301.9,.09,"F",MAILGRP)
  1.  I MAILGRP]"" S XMY("G."_MAILGRP)=""
  1.  ;
  1.  ; if flag is set, send msg to remote mail group specified in
  1.  ; the IVM SITE PARAMETER file
  1.  I $G(MSGS("HEC"))=1 D
  1.  .S MAILGRP=$P($G(^IVM(301.9,1,0)),"^",10)
  1.  .S MAILGRP=$$EXTERNAL^DILFD(301.9,.10,"F",MAILGRP)
  1.  .I MAILGRP]"" S XMY("G."_MAILGRP)=""
  1.  ;
  1.  ;
  1.  S XMTEXT="TEXT("
  1.  S TEXT(1)="The enrollment/eligibility upload produced the following alerts:"
  1.  S TEXT(2)="  "
  1.  S TEXT(3)="Patient Name   :     "_DGPAT("NAME")
  1.  S TEXT(4)="SSN            :     "_DGPAT("SSN")
  1.  S TEXT(5)="DOB            :     "_$$EXTERNAL^DILFD(2,$$FIELD^DGENPTA1("DOB"),"F",DGPAT("DOB"))
  1.  S TEXT(6)="SEX            :     "_$$EXTERNAL^DILFD(2,$$FIELD^DGENPTA1("SEX"),"F",DGPAT("SEX"))
  1.  S TEXT(7)=" "
  1.  ;
  1.  S TEXT(8)=" ** Alerts **"
  1.  S TEXT(9)=" "
  1.  S COUNT=0 F  S COUNT=$O(MSGS(COUNT)) Q:'COUNT  S TEXT(10+COUNT)=COUNT_") "_MSGS(COUNT)
  1.  ;
  1.  D ^XMD
  1.  Q
  1.  ;
  1. BEGUPLD(DFN) ;
  1.  ;Description: Sets a lock used to determine if an eligibility/enrollment
  1.  ;upload is in progress. 
  1.  ;
  1.  ;Input:
  1.  ;   DFN - ien, Patient record
  1.  ;
  1.  ;Output:
  1.  ;  Function value - returns 1 if the lock was obtained, 0 otherwise.
  1.  ;
  1.  Q:'$G(DFN) 1
  1.  L +^DGEN("ELIGIBILITY UPLOAD",DFN):3
  1.  Q $T
  1.  ;
  1. ENDUPLD(DFN) ;
  1.  ;Description: Releases the lock obtained by calling $$BEGUPLD(DFN)
  1.  ;
  1.  Q:'$G(DFN)
  1.  L -^DGEN("ELIGIBILITY UPLOAD",DFN)
  1.  Q
  1.  ;
  1. CKUPLOAD(DFN) ;
  1.  ;Description: Checks if an upload is in progress.  If so, it pauses
  1.  ;until it is completed.
  1.  ;The enrollment/eligibility upload can take a while to accomplish.
  1.  ;If the lock is not obtained initially, it is assumed that the upload
  1.  ;is in progress, and a message is displayed to the user.
  1.  ;
  1.  ;Input: DFN
  1.  ;Output: none
  1.  ;
  1.  N I
  1.  I '$$BEGUPLD(DFN) D
  1.  .W !!,"Upload of patient enrollment/eligibility data is in progress ..."
  1.  .D UNLOCK^DGENPTA1(DFN)
  1.  .F I=1:1:50 Q:$$BEGUPLD(DFN)  W "."
  1.  .W !,"Upload of patient enrollment/eligibility data is completed.",!
  1.  D ENDUPLD(DFN)
  1.  Q
  1. SCVET ;moved from DGENUPL4 - DG*5.3*688
  1.  I DGPAT3("VETERAN")'="N" D
  1.  . I DGELG3("SC")="N" S DGPAT3("VETERAN")="Y",DGPAT3("PATYPE")=$O(^DG(391,"B","NSC VETERAN",0))
  1.  . I DGELG3("SC")="Y" S DGPAT3("VETERAN")="Y",DGPAT3("PATYPE")=$O(^DG(391,"B","SC VETERAN",0))
  1.  I DGPAT3("VETERAN")="N" S DGPAT3("PATYPE")=$$NONVET(DGELG("ELIG","CODE"))
  1.  Q
  1.  ;
  1. NONVET(DGCODE) ;map Patient Type from Primary Elig (and POS)
  1.  ;added with DG*5.3*688 - ERC
  1.  ; input:         DGCODE is the Primary Eligibility code
  1.  ; output:        DGTPYE is returned as the value for Patient Type
  1.  N PTELG,DGTYPE
  1.  S (PTELG,DGTYPE)=""
  1.  Q:$G(DGCODE)']"" ""
  1.  S PTELG=$$NATNAME^DGENELA(DGCODE)
  1.  Q:$G(PTELG)']"" ""
  1.  I "CHAMPVA^OTHER FEDERAL AGENCY^REIMBURSABLE INSURANCE^SHARING AGREEMENT"[PTELG S DGTYPE=$$POS(.DGTYPE) Q:DGTYPE DGTYPE
  1.  S DGTYPE=$S(PTELG["ALLIED":"ALLIED VETERAN",PTELG["COLLATERAL":"COLLATERAL",PTELG["EMPLOYEE":"EMPLOYEE",PTELG["TRICARE":"TRICARE",1:"")
  1.  I DGTYPE']"" S DGTYPE="NON-VETERAN (OTHER)" ;default Pat Type
  1.  S DGTYPE=$O(^DG(391,"B",DGTYPE,""))
  1.  Q DGTYPE
  1. POS(DGTYPE) ;for these Elig Codes, check POS to determine Patient Type
  1.  S DGPOS=DGELG("POS")
  1.  I $G(DGPOS)']"" Q ""
  1.  I '$D(^DIC(21,DGPOS,0)) Q ""
  1.  S DGPOS=$P(^DIC(21,DGPOS,0),U)
  1.  S DGTYPE=$S(DGPOS["ACTIVE":"ACTIVE DUTY",DGPOS["OPERAT":"ACTIVE DUTY",DGPOS["RETIR":"MILITARY RETIREE",1:"")
  1.  I $G(DGTYPE)]"" S DGTYPE=$O(^DG(391,"B",DGTYPE,""))
  1.  Q DGTYPE
  1.  ;
  1.  ;ZMH code moved here from DGENUPL2 - DG*5.3*653
  1. ZMH ;Purple Heart, POW, OEF/OIF Conflict Loc, Military Service Episodes
  1.  ;PROCESS PH, OEF/OIF & POW FROM ZMH
  1.  ;Process Military Service Episodes (SL,SNL,SNNL,MSD) - DG*5.3*797
  1.  I "^SL^SNL^SNNL^MSD^"[("^"_SEG(2)_"^") D  Q
  1.  . N BOS,SN,DIS,SED,SSD,COM
  1.  . S BOS=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH)))  ;Service Branch
  1.  . S:BOS]"" BOS=$O(^DIC(23,"B",BOS,""))
  1.  . S SN=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH),2))  ;Service Number
  1.  . S DIS=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH),3))  ;Discharge Type
  1.  . S:DIS]"" DIS=$O(^DIC(25,"B",DIS,""))
  1.  . S SED=$$CONVERT^DGENUPL1($P(SEG(4),$E(HLECH)),"DATE")  ;Entry Date
  1.  . I 'SED!ERROR D  Q
  1.  . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZMH SEGMENT, SEQ 4, SERVICE ENTRY DATE",.ERRCOUNT)
  1.  . S SSD=$$CONVERT^DGENUPL1($P(SEG(4),$E(HLECH),2),"DATE")  ;Sep. Date
  1.  . S COM=$$CONVERT^DGENUPL1($P(SEG(5),$E(HLECH)))  ;Service Component
  1.  . S DGNMSE(-SED)=SED_U_SSD_U_BOS_U_COM_U_SN_U_DIS_U_1
  1.  ;
  1.  I SEG(2)="PH" D  Q  ;Process Purple Heart from ZMH
  1.  . S DGPAT("PHI")=$P(SEG(3),$E(HLECH))
  1.  . S DGELG("PH")=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH)))
  1.  . S DGPAT("PHST")=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH),2))
  1.  . S DGPAT("PHRR")=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH),3))
  1.  ;
  1.  I SEG(2)="OEIF" D  Q
  1.  . N OEIFLOC
  1.  . S OEIFLOC=$P(SEG(3),$E(HLECH))
  1.  . I OEIFLOC="Conflict Unspecified" Q   ;Ignore these entries
  1.  . I OEIFLOC="Unknown OEF/OIF" S OEIFLOC="UNK"
  1.  . S OEIFLOC=$E(OEIFLOC,1,3)
  1.  . Q:((OEIFLOC'="OIF")&(OEIFLOC'="OEF")&(OEIFLOC'="UNK"))
  1.  . S DGOEIF("COUNT")=$G(DGOEIF("COUNT"))+1
  1.  . S DGOEIF("LOC",DGOEIF("COUNT"))=OEIFLOC
  1.  . S DGOEIF("SITE",DGOEIF("COUNT"))=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH),2),"INSTITUTION")
  1.  . S DGOEIF("FR",DGOEIF("COUNT"))=$$CONVERT^DGENUPL1($P(SEG(4),$E(HLECH)),"DATE")
  1.  . S DGOEIF("TO",DGOEIF("COUNT"))=$$CONVERT^DGENUPL1($P(SEG(4),$E(HLECH),2),"DATE")
  1.  . S DGOEIF("LOCK",DGOEIF("COUNT"))=1
  1.  ;
  1.  I SEG(2)="POW" D  ;Process POW from ZMH
  1.  . S DGPAT("POWI")=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH))) ;POW STATUS INDICATED
  1.  . S DGELG("POW")=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH)))
  1.  . S DGPAT("POWLOC")=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH),2))
  1.  . I DGPAT("POWLOC")'="@" S DGPAT("POWLOC")=$$POWLOC(DGPAT("POWLOC"),.ERROR) ;POW CONFINEMENT LOCATION
  1.  . I ERROR D  Q
  1.  . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZMH SEGMENT, SEQ 3, POW CONFINEMENT LOCATION",.ERRCOUNT)
  1.  . S DGPAT("POWFDT")=$$CONVERT^DGENUPL1($P(SEG(4),$E(HLECH)),"DATE",.ERROR) ;POW FROM DATE
  1.  . I ERROR D  Q
  1.  . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZMH SEGMENT, SEQ 4, POW FROM DATE",.ERRCOUNT)
  1.  . S DGPAT("POWTDT")=$$CONVERT^DGENUPL1($P(SEG(4),$E(HLECH),2),"DATE",.ERROR) ;POW TO DATE
  1.  . I ERROR D  Q
  1.  . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZMH SEGMENT, SEQ 4, POW TO DATE",.ERRCOUNT)
  1.  Q
  1. POWLOC(LOC,ERROR) ;POW Confinement Location mapping with HL7 table VA023
  1.  ;  Input: LOC - HL7 code for location
  1.  ; Output: ERROR - Return error 1 on failure
  1.  ;         IEN22 - IEN of file 22
  1.  N TBL023
  1.  S ERROR=0
  1.  I LOC="" S ERROR=1 Q ""
  1.  S TBL023(4)="WWI",TBL023(5)="WWII-EUROPE",TBL023(6)="WWII-PACIFIC"
  1.  S TBL023(7)="KOREAN",TBL023(8)="VIETNAM",TBL023(9)="OTHER"
  1.  S TBL023("A")="PERSIAN GULF",TBL023("B")="YUGOSLAVIA"
  1.  S IEN22=$O(^DIC(22,"C",TBL023(LOC),""))
  1.  I IEN22="" S ERROR=1
  1.  Q IEN22
  1.  ;