EMERGENCY Released DG*5.3*793 SEQ #707 Extracted from mail message **KIDS**:DG*5.3*793^ **INSTALL NAME** DG*5.3*793 "BLD",7483,0) DG*5.3*793^REGISTRATION^0^3090428^y "BLD",7483,4,0) ^9.64PA^^ "BLD",7483,6.3) 1 "BLD",7483,"KRN",0) ^9.67PA^779.2^20 "BLD",7483,"KRN",.4,0) .4 "BLD",7483,"KRN",.401,0) .401 "BLD",7483,"KRN",.402,0) .402 "BLD",7483,"KRN",.403,0) .403 "BLD",7483,"KRN",.5,0) .5 "BLD",7483,"KRN",.84,0) .84 "BLD",7483,"KRN",3.6,0) 3.6 "BLD",7483,"KRN",3.8,0) 3.8 "BLD",7483,"KRN",9.2,0) 9.2 "BLD",7483,"KRN",9.8,0) 9.8 "BLD",7483,"KRN",9.8,"NM",0) ^9.68A^1^1 "BLD",7483,"KRN",9.8,"NM",1,0) DGENUPL3^^0^B60017954 "BLD",7483,"KRN",9.8,"NM","B","DGENUPL3",1) "BLD",7483,"KRN",19,0) 19 "BLD",7483,"KRN",19.1,0) 19.1 "BLD",7483,"KRN",101,0) 101 "BLD",7483,"KRN",409.61,0) 409.61 "BLD",7483,"KRN",771,0) 771 "BLD",7483,"KRN",779.2,0) 779.2 "BLD",7483,"KRN",870,0) 870 "BLD",7483,"KRN",8989.51,0) 8989.51 "BLD",7483,"KRN",8989.52,0) 8989.52 "BLD",7483,"KRN",8994,0) 8994 "BLD",7483,"KRN","B",.4,.4) "BLD",7483,"KRN","B",.401,.401) "BLD",7483,"KRN","B",.402,.402) "BLD",7483,"KRN","B",.403,.403) "BLD",7483,"KRN","B",.5,.5) "BLD",7483,"KRN","B",.84,.84) "BLD",7483,"KRN","B",3.6,3.6) "BLD",7483,"KRN","B",3.8,3.8) "BLD",7483,"KRN","B",9.2,9.2) "BLD",7483,"KRN","B",9.8,9.8) "BLD",7483,"KRN","B",19,19) "BLD",7483,"KRN","B",19.1,19.1) "BLD",7483,"KRN","B",101,101) "BLD",7483,"KRN","B",409.61,409.61) "BLD",7483,"KRN","B",771,771) "BLD",7483,"KRN","B",779.2,779.2) "BLD",7483,"KRN","B",870,870) "BLD",7483,"KRN","B",8989.51,8989.51) "BLD",7483,"KRN","B",8989.52,8989.52) "BLD",7483,"KRN","B",8994,8994) "BLD",7483,"QUES",0) ^9.62^^ "BLD",7483,"REQB",0) ^9.611^1^1 "BLD",7483,"REQB",1,0) DG*5.3*688^2 "BLD",7483,"REQB","B","DG*5.3*688",1) "MBREQ") 0 "PKG",5,-1) 1^1 "PKG",5,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",5,20,0) ^9.402P^^ "PKG",5,22,0) ^9.49I^1^1 "PKG",5,22,1,0) 5.3^2930813 "PKG",5,22,1,"PAH",1,0) 793^3090428 "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 1 "RTN","DGENUPL3") 0^1^B60017954^B56076045 "RTN","DGENUPL3",1,0) DGENUPL3 ;ALB/CJM,ISA/KWP,AEG,BRM,ERC,CKN,BAJ,PHH,TDM - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ; 4/28/09 8:49am "RTN","DGENUPL3",2,0) ;;5.3;REGISTRATION;**147,230,232,377,404,451,653,688,793**;Aug 13,1993;Build 1 "RTN","DGENUPL3",3,0) ; "RTN","DGENUPL3",4,0) ; "RTN","DGENUPL3",5,0) ADDMSG(MSGS,MESSAGE,TOHEC) ; "RTN","DGENUPL3",6,0) ;Description: Used to add a message to an array of messages to be sent. "RTN","DGENUPL3",7,0) ; "RTN","DGENUPL3",8,0) ;Input: "RTN","DGENUPL3",9,0) ; MSGS - the array to store the message (pass by reference) "RTN","DGENUPL3",10,0) ; MESSAGE - the message to store "RTN","DGENUPL3",11,0) ; TOHEC - a flag, if set to 1 it means that HEC should also receive notification "RTN","DGENUPL3",12,0) ; "RTN","DGENUPL3",13,0) ;Output: none "RTN","DGENUPL3",14,0) ; "RTN","DGENUPL3",15,0) I MESSAGE["DATE OF DEATH" Q "RTN","DGENUPL3",16,0) S MSGS(0)=($G(MSGS(0))+1) "RTN","DGENUPL3",17,0) S MSGS(MSGS(0))=MESSAGE "RTN","DGENUPL3",18,0) I ($G(TOHEC)=1) S MSGS("HEC")=1 "RTN","DGENUPL3",19,0) Q "RTN","DGENUPL3",20,0) ; "RTN","DGENUPL3",21,0) ; "RTN","DGENUPL3",22,0) NOTIFY(DGPAT,MSGS) ; "RTN","DGENUPL3",23,0) ;Description: This is used to send a message to the local mail group "RTN","DGENUPL3",24,0) ;defined by the MAS Parameter ELIGIBILITY UPLOAD MAIL GROUP.The "RTN","DGENUPL3",25,0) ;notification is to be used when specific problems or conditions "RTN","DGENUPL3",26,0) ;regarding the upload of the enrollment or eligibility data. "RTN","DGENUPL3",27,0) ; "RTN","DGENUPL3",28,0) ;Input: "RTN","DGENUPL3",29,0) ; OLDPAT -used if the DGPAT elements have not been built "RTN","DGENUPL3",30,0) ; DGPAT - patient array (pass by reference) "RTN","DGENUPL3",31,0) ; MSGS - the an array of messages that should be included in the "RTN","DGENUPL3",32,0) ; notification (pass by reference). If MSGS("HEC")=1 "RTN","DGENUPL3",33,0) ; it means that HEC should also receive notification. "RTN","DGENUPL3",34,0) ; "RTN","DGENUPL3",35,0) ;Output: none "RTN","DGENUPL3",36,0) ; "RTN","DGENUPL3",37,0) N TEXT,XMDUZ,XMTEXT,XMSUB,XMSTRIP,XMROU,XMY,XMZ,XMDF,COUNT "RTN","DGENUPL3",38,0) N HEADER,NSC,POW,TMPSTR,MAILGRP,ELIG,CD "RTN","DGENUPL3",39,0) ; "RTN","DGENUPL3",40,0) ;if there are no alerts, then quit "RTN","DGENUPL3",41,0) Q:'$G(MSGS(0)) "RTN","DGENUPL3",42,0) ; "RTN","DGENUPL3",43,0) ;Get reason for alert. If there is more than one reason decide which "RTN","DGENUPL3",44,0) ;reason to display. 'NON-SERVICE' alerts have a higher priority than "RTN","DGENUPL3",45,0) ;other alerts and are therefore displayed before other alerts in the "RTN","DGENUPL3",46,0) ;subject line, followed by 'POW' alerts in priority. "RTN","DGENUPL3",47,0) S (ELIG,NSC,POW,CD)=0 "RTN","DGENUPL3",48,0) S COUNT=0 F S COUNT=$O(MSGS(COUNT)) Q:'COUNT!NSC D "RTN","DGENUPL3",49,0) .I MSGS(COUNT)["PREVIOUSLY ELIGIBLE" S ELIG=1 Q "RTN","DGENUPL3",50,0) .I MSGS(COUNT)["NON-SERVICE" S NSC=1 Q "RTN","DGENUPL3",51,0) .I MSGS(COUNT)["POW" S POW=1 Q "RTN","DGENUPL3",52,0) .I MSGS(COUNT)["CD EVALUATION" S CD=1 Q "RTN","DGENUPL3",53,0) .S HEADER=MSGS(COUNT) "RTN","DGENUPL3",54,0) .Q "RTN","DGENUPL3",55,0) D "RTN","DGENUPL3",56,0) .I ELIG S HEADER="Ineligibility Alert: " Q "RTN","DGENUPL3",57,0) .I NSC S HEADER="NSC Alert: " Q "RTN","DGENUPL3",58,0) .I POW&'NSC S HEADER="POW Alert: " Q "RTN","DGENUPL3",59,0) .I CD S HEADER="CD Alert: " Q "RTN","DGENUPL3",60,0) .Q "RTN","DGENUPL3",61,0) ; "RTN","DGENUPL3",62,0) S XMDF="" "RTN","DGENUPL3",63,0) S (XMDUN,XMDUZ)="Registration Enrollment Module" "RTN","DGENUPL3",64,0) ;Phase II Re-Enrollment "RTN","DGENUPL3",65,0) ;DGPAT("SSN") is built by the parser. DGPAT("NAME"),DGPAT("SEX"),DGPAT("DOB")(are merged into DGPAT from OLDPAT. "RTN","DGENUPL3",66,0) ;The checks below are to setup the DGPAT elements from OLDPAT if NOTIFY is called before the merge. "RTN","DGENUPL3",67,0) I '$D(DGPAT("NAME")) S DGPAT("NAME")=$G(OLDPAT("NAME")) "RTN","DGENUPL3",68,0) I '$D(DGPAT("SEX")) S DGPAT("SEX")=$G(OLDPAT("SEX")) "RTN","DGENUPL3",69,0) I '$D(DGPAT("DOB")) S DGPAT("DOB")=$G(OLDPAT("DOB")) "RTN","DGENUPL3",70,0) S TMPSTR=" ("_$E(DGPAT("NAME"),1,1) "RTN","DGENUPL3",71,0) S TMPSTR=TMPSTR_$E(DGPAT("SSN"),$L(DGPAT("SSN"))-3,1000)_")" "RTN","DGENUPL3",72,0) S XMSUB=$E(HEADER,1,30)_$E(DGPAT("NAME"),1,25)_TMPSTR "RTN","DGENUPL3",73,0) ; "RTN","DGENUPL3",74,0) ; send msg to local mail group specified in IVM SITE PARAMETER file "RTN","DGENUPL3",75,0) S MAILGRP=+$P($G(^IVM(301.9,1,0)),"^",9) "RTN","DGENUPL3",76,0) S MAILGRP=$$EXTERNAL^DILFD(301.9,.09,"F",MAILGRP) "RTN","DGENUPL3",77,0) I MAILGRP]"" S XMY("G."_MAILGRP)="" "RTN","DGENUPL3",78,0) ; "RTN","DGENUPL3",79,0) ; if flag is set, send msg to remote mail group specified in "RTN","DGENUPL3",80,0) ; the IVM SITE PARAMETER file "RTN","DGENUPL3",81,0) I $G(MSGS("HEC"))=1 D "RTN","DGENUPL3",82,0) .S MAILGRP=$P($G(^IVM(301.9,1,0)),"^",10) "RTN","DGENUPL3",83,0) .S MAILGRP=$$EXTERNAL^DILFD(301.9,.10,"F",MAILGRP) "RTN","DGENUPL3",84,0) .I MAILGRP]"" S XMY("G."_MAILGRP)="" "RTN","DGENUPL3",85,0) ; "RTN","DGENUPL3",86,0) ; "RTN","DGENUPL3",87,0) S XMTEXT="TEXT(" "RTN","DGENUPL3",88,0) S TEXT(1)="The enrollment/eligibility upload produced the following alerts:" "RTN","DGENUPL3",89,0) S TEXT(2)=" " "RTN","DGENUPL3",90,0) S TEXT(3)="Patient Name : "_DGPAT("NAME") "RTN","DGENUPL3",91,0) S TEXT(4)="SSN : "_DGPAT("SSN") "RTN","DGENUPL3",92,0) S TEXT(5)="DOB : "_$$EXTERNAL^DILFD(2,$$FIELD^DGENPTA1("DOB"),"F",DGPAT("DOB")) "RTN","DGENUPL3",93,0) S TEXT(6)="SEX : "_$$EXTERNAL^DILFD(2,$$FIELD^DGENPTA1("SEX"),"F",DGPAT("SEX")) "RTN","DGENUPL3",94,0) S TEXT(7)=" " "RTN","DGENUPL3",95,0) ; "RTN","DGENUPL3",96,0) S TEXT(8)=" ** Alerts **" "RTN","DGENUPL3",97,0) S TEXT(9)=" " "RTN","DGENUPL3",98,0) S COUNT=0 F S COUNT=$O(MSGS(COUNT)) Q:'COUNT S TEXT(10+COUNT)=COUNT_") "_MSGS(COUNT) "RTN","DGENUPL3",99,0) ; "RTN","DGENUPL3",100,0) D ^XMD "RTN","DGENUPL3",101,0) Q "RTN","DGENUPL3",102,0) ; "RTN","DGENUPL3",103,0) BEGUPLD(DFN) ; "RTN","DGENUPL3",104,0) ;Description: Sets a lock used to determine if an eligibility/enrollment "RTN","DGENUPL3",105,0) ;upload is in progress. "RTN","DGENUPL3",106,0) ; "RTN","DGENUPL3",107,0) ;Input: "RTN","DGENUPL3",108,0) ; DFN - ien, Patient record "RTN","DGENUPL3",109,0) ; "RTN","DGENUPL3",110,0) ;Output: "RTN","DGENUPL3",111,0) ; Function value - returns 1 if the lock was obtained, 0 otherwise. "RTN","DGENUPL3",112,0) ; "RTN","DGENUPL3",113,0) Q:'$G(DFN) 1 "RTN","DGENUPL3",114,0) L +^DGEN("ELIGIBILITY UPLOAD",DFN):3 "RTN","DGENUPL3",115,0) Q $T "RTN","DGENUPL3",116,0) ; "RTN","DGENUPL3",117,0) ENDUPLD(DFN) ; "RTN","DGENUPL3",118,0) ;Description: Releases the lock obtained by calling $$BEGUPLD(DFN) "RTN","DGENUPL3",119,0) ; "RTN","DGENUPL3",120,0) Q:'$G(DFN) "RTN","DGENUPL3",121,0) L -^DGEN("ELIGIBILITY UPLOAD",DFN) "RTN","DGENUPL3",122,0) Q "RTN","DGENUPL3",123,0) ; "RTN","DGENUPL3",124,0) CKUPLOAD(DFN) ; "RTN","DGENUPL3",125,0) ;Description: Checks if an upload is in progress. If so, it pauses "RTN","DGENUPL3",126,0) ;until it is completed. "RTN","DGENUPL3",127,0) ;The enrollment/eligibility upload can take a while to accomplish. "RTN","DGENUPL3",128,0) ;If the lock is not obtained initially, it is assumed that the upload "RTN","DGENUPL3",129,0) ;is in progress, and a message is displayed to the user. "RTN","DGENUPL3",130,0) ; "RTN","DGENUPL3",131,0) ;Input: DFN "RTN","DGENUPL3",132,0) ;Output: none "RTN","DGENUPL3",133,0) ; "RTN","DGENUPL3",134,0) N I "RTN","DGENUPL3",135,0) I '$$BEGUPLD(DFN) D "RTN","DGENUPL3",136,0) .W !!,"Upload of patient enrollment/eligibility data is in progress ..." "RTN","DGENUPL3",137,0) .D UNLOCK^DGENPTA1(DFN) "RTN","DGENUPL3",138,0) .F I=1:1:50 Q:$$BEGUPLD(DFN) W "." "RTN","DGENUPL3",139,0) .W !,"Upload of patient enrollment/eligibility data is completed.",! "RTN","DGENUPL3",140,0) D ENDUPLD(DFN) "RTN","DGENUPL3",141,0) Q "RTN","DGENUPL3",142,0) SCVET ;moved from DGENUPL4 - DG*5.3*688 "RTN","DGENUPL3",143,0) I DGPAT3("VETERAN")'="N" D "RTN","DGENUPL3",144,0) . I DGELG3("SC")="N" S DGPAT3("VETERAN")="Y",DGPAT3("PATYPE")=$O(^DG(391,"B","NSC VETERAN",0)) "RTN","DGENUPL3",145,0) . I DGELG3("SC")="Y" S DGPAT3("VETERAN")="Y",DGPAT3("PATYPE")=$O(^DG(391,"B","SC VETERAN",0)) "RTN","DGENUPL3",146,0) I DGPAT3("VETERAN")="N" S DGPAT3("PATYPE")=$$NONVET(DGELG("ELIG","CODE")) "RTN","DGENUPL3",147,0) Q "RTN","DGENUPL3",148,0) ; "RTN","DGENUPL3",149,0) NONVET(DGCODE) ;map Patient Type from Primary Elig (and POS) "RTN","DGENUPL3",150,0) ;added with DG*5.3*688 - ERC "RTN","DGENUPL3",151,0) ; input: DGCODE is the Primary Eligibility code "RTN","DGENUPL3",152,0) ; output: DGTPYE is returned as the value for Patient Type "RTN","DGENUPL3",153,0) N PTELG,DGTYPE "RTN","DGENUPL3",154,0) S (PTELG,DGTYPE)="" "RTN","DGENUPL3",155,0) Q:$G(DGCODE)']"" "" "RTN","DGENUPL3",156,0) S PTELG=$$NATNAME^DGENELA(DGCODE) "RTN","DGENUPL3",157,0) Q:$G(PTELG)']"" "" "RTN","DGENUPL3",158,0) I "CHAMPVA^OTHER FEDERAL AGENCY^REIMBURSABLE INSURANCE^SHARING AGREEMENT"[PTELG S DGTYPE=$$POS(.DGTYPE) Q:DGTYPE DGTYPE "RTN","DGENUPL3",159,0) S DGTYPE=$S(PTELG["ALLIED":"ALLIED VETERAN",PTELG["COLLATERAL":"COLLATERAL",PTELG["EMPLOYEE":"EMPLOYEE",PTELG["TRICARE":"TRICARE",1:"") "RTN","DGENUPL3",160,0) I DGTYPE']"" S DGTYPE="NON-VETERAN (OTHER)" ;default Pat Type "RTN","DGENUPL3",161,0) S DGTYPE=$O(^DG(391,"B",DGTYPE,"")) "RTN","DGENUPL3",162,0) Q DGTYPE "RTN","DGENUPL3",163,0) POS(DGTYPE) ;for these Elig Codes, check POS to determine Patient Type "RTN","DGENUPL3",164,0) S DGPOS=DGELG("POS") "RTN","DGENUPL3",165,0) I $G(DGPOS)']"" Q "" "RTN","DGENUPL3",166,0) I '$D(^DIC(21,DGPOS,0)) Q "" "RTN","DGENUPL3",167,0) S DGPOS=$P(^DIC(21,DGPOS,0),U) "RTN","DGENUPL3",168,0) S DGTYPE=$S(DGPOS["ACTIVE":"ACTIVE DUTY",DGPOS["OPERAT":"ACTIVE DUTY",DGPOS["RETIR":"MILITARY RETIREE",1:"") "RTN","DGENUPL3",169,0) I $G(DGTYPE)]"" S DGTYPE=$O(^DG(391,"B",DGTYPE,"")) "RTN","DGENUPL3",170,0) Q DGTYPE "RTN","DGENUPL3",171,0) ; "RTN","DGENUPL3",172,0) ;ZMH code moved here from DGENUPL2 - DG*5.3*653 "RTN","DGENUPL3",173,0) ZMH ;Purple Heart, POW, OEF/OIF Conflict Loc "RTN","DGENUPL3",174,0) ;ONLY PROCESS PH, OEF/OIF & POW FROM ZMH "RTN","DGENUPL3",175,0) Q:$S(SEG(2)="PH":0,SEG(2)="OEIF":0,SEG(2)="POW":0,1:1) "RTN","DGENUPL3",176,0) I SEG(2)="PH" D Q ;Process Purple Heart from ZMH "RTN","DGENUPL3",177,0) . S DGPAT("PHI")=$P(SEG(3),$E(HLECH)) "RTN","DGENUPL3",178,0) . S DGELG("PH")=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH))) "RTN","DGENUPL3",179,0) . S DGPAT("PHST")=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH),2)) "RTN","DGENUPL3",180,0) . S DGPAT("PHRR")=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH),3)) "RTN","DGENUPL3",181,0) ; "RTN","DGENUPL3",182,0) I SEG(2)="OEIF" D Q "RTN","DGENUPL3",183,0) . N OEIFLOC "RTN","DGENUPL3",184,0) . S OEIFLOC=$P(SEG(3),$E(HLECH)) "RTN","DGENUPL3",185,0) . I OEIFLOC="Conflict Unspecified" Q ;Ignore these entries "RTN","DGENUPL3",186,0) . I OEIFLOC="Unknown OEF/OIF" S OEIFLOC="UNK" "RTN","DGENUPL3",187,0) . S OEIFLOC=$E(OEIFLOC,1,3) "RTN","DGENUPL3",188,0) . Q:((OEIFLOC'="OIF")&(OEIFLOC'="OEF")&(OEIFLOC'="UNK")) "RTN","DGENUPL3",189,0) . S DGOEIF("COUNT")=$G(DGOEIF("COUNT"))+1 "RTN","DGENUPL3",190,0) . S DGOEIF("LOC",DGOEIF("COUNT"))=OEIFLOC "RTN","DGENUPL3",191,0) . S DGOEIF("SITE",DGOEIF("COUNT"))=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH),2),"INSTITUTION") "RTN","DGENUPL3",192,0) . S DGOEIF("FR",DGOEIF("COUNT"))=$$CONVERT^DGENUPL1($P(SEG(4),$E(HLECH)),"DATE") "RTN","DGENUPL3",193,0) . S DGOEIF("TO",DGOEIF("COUNT"))=$$CONVERT^DGENUPL1($P(SEG(4),$E(HLECH),2),"DATE") "RTN","DGENUPL3",194,0) . S DGOEIF("LOCK",DGOEIF("COUNT"))=1 "RTN","DGENUPL3",195,0) ; "RTN","DGENUPL3",196,0) I SEG(2)="POW" D ;Process POW from ZMH "RTN","DGENUPL3",197,0) . S DGPAT("POWI")=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH))) ;POW STATUS INDICATED "RTN","DGENUPL3",198,0) . S DGELG("POW")=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH))) "RTN","DGENUPL3",199,0) . S DGPAT("POWLOC")=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH),2)) "RTN","DGENUPL3",200,0) . I DGPAT("POWLOC")'="@" S DGPAT("POWLOC")=$$POWLOC(DGPAT("POWLOC"),.ERROR) ;POW CONFINEMENT LOCATION "RTN","DGENUPL3",201,0) . I ERROR D Q "RTN","DGENUPL3",202,0) . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZMH SEGMENT, SEQ 3, POW CONFINEMENT LOCATION",.ERRCOUNT) "RTN","DGENUPL3",203,0) . S DGPAT("POWFDT")=$$CONVERT^DGENUPL1($P(SEG(4),$E(HLECH)),"DATE",.ERROR) ;POW FROM DATE "RTN","DGENUPL3",204,0) . I ERROR D Q "RTN","DGENUPL3",205,0) . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZMH SEGMENT, SEQ 4, POW FROM DATE",.ERRCOUNT) "RTN","DGENUPL3",206,0) . S DGPAT("POWTDT")=$$CONVERT^DGENUPL1($P(SEG(4),$E(HLECH),2),"DATE",.ERROR) ;POW TO DATE "RTN","DGENUPL3",207,0) . I ERROR D Q "RTN","DGENUPL3",208,0) . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZMH SEGMENT, SEQ 4, POW TO DATE",.ERRCOUNT) "RTN","DGENUPL3",209,0) Q "RTN","DGENUPL3",210,0) POWLOC(LOC,ERROR) ;POW Confinement Location mapping with HL7 table VA023 "RTN","DGENUPL3",211,0) ; Input: LOC - HL7 code for location "RTN","DGENUPL3",212,0) ; Output: ERROR - Return error 1 on failure "RTN","DGENUPL3",213,0) ; IEN22 - IEN of file 22 "RTN","DGENUPL3",214,0) N TBL023 "RTN","DGENUPL3",215,0) S ERROR=0 "RTN","DGENUPL3",216,0) I LOC="" S ERROR=1 Q "" "RTN","DGENUPL3",217,0) S TBL023(4)="WWI",TBL023(5)="WWII-EUROPE",TBL023(6)="WWII-PACIFIC" "RTN","DGENUPL3",218,0) S TBL023(7)="KOREAN",TBL023(8)="VIETNAM",TBL023(9)="OTHER" "RTN","DGENUPL3",219,0) S TBL023("A")="PERSIAN GULF",TBL023("B")="YUGOSLAVIA" "RTN","DGENUPL3",220,0) S IEN22=$O(^DIC(22,"C",TBL023(LOC),"")) "RTN","DGENUPL3",221,0) I IEN22="" S ERROR=1 "RTN","DGENUPL3",222,0) Q IEN22 "RTN","DGENUPL3",223,0) ; "VER") 8.0^22.0 "BLD",7483,6) ^707 **END** **END**