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,DJS,KUM,JAM,HM - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ;12 June 2018 5:35PM
  1. ;;5.3;REGISTRATION;**147,230,232,377,404,451,653,688,793,797,841,928,935,947,966,972**;Aug 13,1993;Build 80
  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,DGFDD
  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. ;Patch DG*5.3*928 is removing ability to send emails to remote email group. Emails have been decommissioned and no longer required.
  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, Medal of Honor
  1. ;PROCESS PH, OEF/OIF, MH & POW FROM ZMH
  1. ;Process Military Service Episodes (SL,SNL,SNNL,MSD) - DG*5.3*797
  1. ;Process Military Service Episodes (SL,SNL,SNNL,MSD,FDD) - Future Discharge Date Added DG*5.3*935
  1. ;Process Military Service Episodes (SL,SNL,SNNL,MSD,FDD) - Reason for Early Separation Added DG*5.3*947
  1. ;Process Military Service Episodes (SL,SNL,SNNL,MSD,FDD) - Separation Reason Code added DG*5.3*966
  1. ;DJS, Indicate if the ZMH segment exists in this message; DG*5.3*935
  1. N DGNEW
  1. S ^TMP($J,"DGENUPL","ZMH",0)=1
  1. I "^SL^SNL^SNNL^MSD^FDD^"[("^"_SEG(2)_"^") D Q
  1. . ;DJS, Store the Future Discharge Date (FDD); DG*5.3*935
  1. . I SEG(2)="FDD"&($L(SEG(8))<5) S SEG(8)="",I=0 D Q
  1. . . ;JAM, FDD is NONEDITABLE in FileMan so this code is modified to directly delete the field; DG*5.3*972
  1. . . ;S DGNEW=0 F S I=$O(^DPT(DFN,.3216,I)) Q:I'?.N!($G(I)="") S DA(1)=DFN,DA=I,DIE="^DPT("_DA(1)_","_.3216_",",DIE(0)="",DR=".08///@" D ^DIE D ID1^DGNOZMH(DFN,I,DGNEW) S I=DA ;Delete an incomplete MSE ;DG*5.3*935
  1. . . S DGNEW=0 F S I=$O(^DPT(DFN,.3216,I)) Q:I'?.N!($G(I)="") S $P(^DPT(DFN,.3216,I,0),"^",8)="" D ID1^DGNOZMH(DFN,I,DGNEW) ;Delete an incomplete MSE ;DG*5.3*935
  1. . . K DGNEW Q
  1. . N BOS,SN,DIS,SED,SSD,COM,DGFDD,DIE,DA,DR,RES,RESCODE S ERROR=""
  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. . . Q:SEG(2)="FDD"&(SEG(8)="") 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. . ;Add Reason for Early Separation - DG*5.3*947
  1. . S RES=$$CONVERT^DGENUPL1($P(SEG(9),$E(HLECH))) ;Reason for Early Separation (free text)
  1. . ;Add Separation Reason Code (variable is NEW'd above and set into the DGNMSE array below) - DG*5.3*966
  1. . S RESCODE=$$CONVERT^DGENUPL1($P(SEG(10),$E(HLECH))) ;Separation Reason Code (3 digit)
  1. . ;DJS, Create variable DGFDD for storage in Military Service Episode (MSE); DG*5.3*935
  1. . ;DJS, Create MSE whether or not FDD exists & is a valid date; DG*5.3*935
  1. . I SEG(2)="FDD" D
  1. . . S DGFDD=$$CONVERT^DGENUPL1($P(SEG(8),$E(HLECH)),"DATE")
  1. . . I $$VALID^DGRPDT(.DGFDD)=1 D
  1. . . .S DGNMSE(-SED)=SED_U_SSD_U_BOS_U_COM_U_SN_U_DIS_U_1_U_DGFDD
  1. . ;E S DGNMSE(-SED)=SED_U_SSD_U_BOS_U_COM_U_SN_U_DIS_U_1
  1. . E S DGNMSE(-SED)=SED_U_SSD_U_BOS_U_COM_U_SN_U_DIS_U_1_U_U_RES_U_RESCODE
  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. ;
  1. I SEG(2)="MH" D ;Process Medal of Honor from ZMH
  1. . N TODAY,Y,DGVDOB,DGLEGDT,DGERRMSG,VAEL
  1. . S DGPAT("MOH")=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH))) ;MH STATUS INDICATED
  1. . ;MOH DG*5.3*972 HM changes start here
  1. . S DGELG("MOH")=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH)))
  1. . I DGELG("MOH")="Y" D
  1. . . I $G(DGPAT("VETERAN"))="Y" Q ;CHECK IF VETERAN FROM ZEL SEGMENT
  1. . . I $G(DGPAT("VETERAN"))="N" S ERROR=1 Q ;IF NOT VETERAN SET ERROR
  1. . . D ELIG^VADPT I $G(VAEL(4))'=1 S ERROR=1 ;IF CANNOT DETERMINE VETERAN STATUS CALL ELIG^VADPT TO GET STATUS FROM DB, IF NON VETERAN SET ERROR
  1. . I ERROR D Q
  1. . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZMH SEGMENT, SEQ 3, NON VETERAN INELIGIBLE FOR MEDAL OF HONOR",.ERRCOUNT)
  1. . S DGPAT("MOHAWRDDATE")=$$CONVERT^DGENUPL1($P(SEG(4),$E(HLECH),1),"DATE",.ERROR)
  1. . S DGELG("MOHAWRDDATE")=$$CONVERT^DGENUPL1($P(SEG(4),$E(HLECH),1),"DATE",.ERROR)
  1. . I DGPAT("MOH")="N",DGPAT("MOHAWRDDATE")="""" S ERROR=0 ;NO ERROR IF AWARD DATE IS EMPTY STRING
  1. . I DGPAT("MOH")="N" S DGPAT("MOHAWRDDATE")="",DGELG("MOHAWRDDATE")="" ;IF MOH = 'N' SET AWARD DATE TO NULL
  1. . S DGLEGDT=3161216 ;MOH LEGISLATION DATE 2016/12/16
  1. . I $G(DGPAT("MOHAWRDDATE")) D ;MH AWARD DATE
  1. . . I DGPAT("MOHAWRDDATE")>DT S ERROR=1
  1. . . S DGERRMSG="BAD VALUE, ZMH SEGMENT, SEQ 4, MH AWARD DATE IS IN THE FUTURE" ;IF AWARD DATE IS IN FUTURE
  1. . . S DGVDOB=$P(^DPT(+DFN,0),"^",3)
  1. . . I DGPAT("MOHAWRDDATE")-DGVDOB<150000 S ERROR=1,DGERRMSG="BAD VALUE, ZMH SEGMENT, SEQ 4, MH AWARD DATE BEFORE BIRTH DATE" ;IF AWARD DATE IS LESS THE DOB + 15 YEARS ;MH AWARD DATE
  1. . I ERROR D Q
  1. . . S DGPAT("MOHAWRDDATE")="" ;IF AWARD FAILS VALIDATION SE TO "" ;MH AWARD DATE
  1. . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),DGERRMSG,.ERRCOUNT) ;MH AWARD DATE
  1. . S DGPAT("MOHSTATDATE")=$$CONVERT^DGENUPL1($P(SEG(4),$E(HLECH),2),"DATE",.ERROR) ;MH STATUS DATE
  1. . S DGELG("MOHSTATDATE")=$$CONVERT^DGENUPL1($P(SEG(4),$E(HLECH),2),"DATE",.ERROR) ;MH STATUS DATE
  1. . I DGPAT("MOH")="N",DGPAT("MOHSTATDATE")="""" S ERROR=0,DGPAT("MOHSTATDATE")="" ;NO ERROR IF AWARD DATE IS EMPTY STRING
  1. . I DGPAT("MOH")="N",DGPAT("MOHSTATDATE")="" S DGPAT("MOHSTATDATE")=DT,DGELG("MOHSTATDATE")=DT ;IF MOH IS "N' AND STATUS IS NULL SET STATUS DATE TO TODAY
  1. . I ERROR D Q
  1. . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZMH SEGMENT, SEQ 4, MH STATUS DATE MISSING",.ERRCOUNT)
  1. . I DGPAT("MOH")="N" S DGPAT("MOHEXEMPDATE")="",DGELG("MOHEXEMPDATE")=""
  1. . I $G(DGPAT("MOHAWRDDATE")) D
  1. . . I DGPAT("MOHAWRDDATE")<DGLEGDT S DGPAT("MOHEXEMPDATE")=DGLEGDT,DGELG("MOHEXEMPDATE")=DGLEGDT
  1. . . I DGPAT("MOHAWRDDATE")=DGLEGDT S DGPAT("MOHEXEMPDATE")=DGPAT("MOHAWRDDATE"),DGELG("MOHEXEMPDATE")=DGPAT("MOHAWRDDATE")
  1. . . I DGPAT("MOHAWRDDATE")>DGLEGDT S DGPAT("MOHEXEMPDATE")=DGPAT("MOHAWRDDATE"),DGELG("MOHEXEMPDATE")=DGPAT("MOHAWRDDATE")
  1. . ;MOH DG*5.3*972 HM changes end here
  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. ;