KIDS Distribution saved on Jun 02, 2020@18:56:46 SAMI REC ORM HL7 V 18.0 **KIDS**:SAMI REC ORM HL7 V 18.0^ **INSTALL NAME** SAMI REC ORM HL7 V 18.0 "BLD",10814,0) SAMI REC ORM HL7 V 18.0^^0^3200602^n "BLD",10814,1,0) ^^3^3^3200531^ "BLD",10814,1,1,0) KIDS with SAMIORM and SAMIHL7, the two routines needed to process "BLD",10814,1,2,0) incoming HL7 ORM messages and file the information into the "BLD",10814,1,3,0) patient-lookup graph "BLD",10814,4,0) ^9.64PA^^ "BLD",10814,6.3) 3 "BLD",10814,"KRN",0) ^9.67PA^1.5^24 "BLD",10814,"KRN",.4,0) .4 "BLD",10814,"KRN",.401,0) .401 "BLD",10814,"KRN",.402,0) .402 "BLD",10814,"KRN",.403,0) .403 "BLD",10814,"KRN",.5,0) .5 "BLD",10814,"KRN",.84,0) .84 "BLD",10814,"KRN",1.5,0) 1.5 "BLD",10814,"KRN",1.6,0) 1.6 "BLD",10814,"KRN",1.61,0) 1.61 "BLD",10814,"KRN",1.62,0) 1.62 "BLD",10814,"KRN",3.6,0) 3.6 "BLD",10814,"KRN",3.8,0) 3.8 "BLD",10814,"KRN",9.2,0) 9.2 "BLD",10814,"KRN",9.8,0) 9.8 "BLD",10814,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",10814,"KRN",9.8,"NM",1,0) SAMIORM^^0^B47358865 "BLD",10814,"KRN",9.8,"NM",2,0) SAMIHL7^^0^B63028909 "BLD",10814,"KRN",9.8,"NM","B","SAMIHL7",2) "BLD",10814,"KRN",9.8,"NM","B","SAMIORM",1) "BLD",10814,"KRN",19,0) 19 "BLD",10814,"KRN",19.1,0) 19.1 "BLD",10814,"KRN",101,0) 101 "BLD",10814,"KRN",409.61,0) 409.61 "BLD",10814,"KRN",771,0) 771 "BLD",10814,"KRN",779.2,0) 779.2 "BLD",10814,"KRN",870,0) 870 "BLD",10814,"KRN",8989.51,0) 8989.51 "BLD",10814,"KRN",8989.52,0) 8989.52 "BLD",10814,"KRN",8994,0) 8994 "BLD",10814,"KRN","B",.4,.4) "BLD",10814,"KRN","B",.401,.401) "BLD",10814,"KRN","B",.402,.402) "BLD",10814,"KRN","B",.403,.403) "BLD",10814,"KRN","B",.5,.5) "BLD",10814,"KRN","B",.84,.84) "BLD",10814,"KRN","B",1.5,1.5) "BLD",10814,"KRN","B",1.6,1.6) "BLD",10814,"KRN","B",1.61,1.61) "BLD",10814,"KRN","B",1.62,1.62) "BLD",10814,"KRN","B",3.6,3.6) "BLD",10814,"KRN","B",3.8,3.8) "BLD",10814,"KRN","B",9.2,9.2) "BLD",10814,"KRN","B",9.8,9.8) "BLD",10814,"KRN","B",19,19) "BLD",10814,"KRN","B",19.1,19.1) "BLD",10814,"KRN","B",101,101) "BLD",10814,"KRN","B",409.61,409.61) "BLD",10814,"KRN","B",771,771) "BLD",10814,"KRN","B",779.2,779.2) "BLD",10814,"KRN","B",870,870) "BLD",10814,"KRN","B",8989.51,8989.51) "BLD",10814,"KRN","B",8989.52,8989.52) "BLD",10814,"KRN","B",8994,8994) "BLD",10814,"QUES",0) ^9.62^^ "BLD",10814,"REQB",0) ^9.611^^ "MBREQ") 0 "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") 2 "RTN","SAMIHL7") 0^2^B63028909 "RTN","SAMIHL7",1,0) SAMIHL7 ;SAMI/lgc/arc - HL7 UTILITIES ;Jun 02, 2020@18:44 "RTN","SAMIHL7",2,0) ;;18.0;SAMI;;;Build 3 "RTN","SAMIHL7",3,0) ; "RTN","SAMIHL7",4,0) quit ; no entry from top "RTN","SAMIHL7",5,0) ; "RTN","SAMIHL7",6,0) ; "RTN","SAMIHL7",7,0) ;@ppi "RTN","SAMIHL7",8,0) UPDTPTL(fields) ; Update patient-lookup with a patient fields array "RTN","SAMIHL7",9,0) ;@input "RTN","SAMIHL7",10,0) ; fields = array of patient data "RTN","SAMIHL7",11,0) ;@output "RTN","SAMIHL7",12,0) ; existing entry in patient-lookup graph updated "RTN","SAMIHL7",13,0) ; or new patient entered "RTN","SAMIHL7",14,0) ; "RTN","SAMIHL7",15,0) kill ^KBAP("SAMIHL7") "RTN","SAMIHL7",16,0) set ^KBAP("SAMIHL7","UPDTPTL")="" "RTN","SAMIHL7",17,0) ; "RTN","SAMIHL7",18,0) ; bail if we didn't get a fields array "RTN","SAMIHL7",19,0) quit:'$data(fields) "RTN","SAMIHL7",20,0) ; "RTN","SAMIHL7",21,0) UPDTPTL1 ; "RTN","SAMIHL7",22,0) set ^KBAP("SAMIHL7","UPDTPTL1")="" "RTN","SAMIHL7",23,0) ; "RTN","SAMIHL7",24,0) new rootpl s rootpl=$$setroot^%wd("patient-lookup") "RTN","SAMIHL7",25,0) new ptienssn,ptiennm,ptiendob,ptienssntmp "RTN","SAMIHL7",26,0) set (ptienssn,ptiennm,ptiendob,ptienssntmp)=0 "RTN","SAMIHL7",27,0) new ptien,newpat set ptien=0,newpat=1 "RTN","SAMIHL7",28,0) ; "RTN","SAMIHL7",29,0) ; Look for the existing patients with matching ssn. "RTN","SAMIHL7",30,0) ; if one has a matching name we don't make a new patient "RTN","SAMIHL7",31,0) ; but rather update the existing with changelog "RTN","SAMIHL7",32,0) ; "RTN","SAMIHL7",33,0) if $length($get(fields("ssn"))),$data(@rootpl@("ssn",$get(fields("ssn")))) do "RTN","SAMIHL7",34,0) . set ptienssntmp=$order(@rootpl@("ssn",$get(fields("ssn")),0)) "RTN","SAMIHL7",35,0) . for set ptienssn=$order(@rootpl@("ssn",$get(fields("ssn")),ptienssn)) quit:'ptienssn do quit:ptiennm "RTN","SAMIHL7",36,0) .. if $length($get(fields("saminame"))),(@rootpl@(ptienssn,"saminame")=fields("saminame")) do "RTN","SAMIHL7",37,0) ... set ptiennm=ptienssn "RTN","SAMIHL7",38,0) ; "RTN","SAMIHL7",39,0) set ^KBAP("SAMIHL7","UPDTPTL1","A")="" "RTN","SAMIHL7",40,0) ; "RTN","SAMIHL7",41,0) if ptienssn,ptiennm do "RTN","SAMIHL7",42,0) . new fixdob s fixdob=@rootpl@(ptienssn,"sbdob") "RTN","SAMIHL7",43,0) . set fixdob=$piece(fixdob,"-")_"-"_$tr($j($piece(fixdob,"-",2),2)," ","0")_"-"_$tr($j($piece(fixdob,"-",3),2)," ","0") "RTN","SAMIHL7",44,0) . if $length($get(fields("sbdob"))),(fixdob=fields("sbdob")) set ptiendob=ptienssn "RTN","SAMIHL7",45,0) . s newpat=0,ptien=ptienssn "RTN","SAMIHL7",46,0) ; "RTN","SAMIHL7",47,0) ; "RTN","SAMIHL7",48,0) set ^KBAP("SAMIHL7","UPDTPTL1","B")="" "RTN","SAMIHL7",49,0) ; "RTN","SAMIHL7",50,0) ; if there was no name match, restore ptienssn to the first ssn cross ref match "RTN","SAMIHL7",51,0) set:'ptienssn ptienssn=ptienssntmp "RTN","SAMIHL7",52,0) ; "RTN","SAMIHL7",53,0) ; if existing patient save existing data "RTN","SAMIHL7",54,0) new oldarr "RTN","SAMIHL7",55,0) if ptien merge oldarr=@rootpl@(ptien) "RTN","SAMIHL7",56,0) ; "RTN","SAMIHL7",57,0) ; "RTN","SAMIHL7",58,0) set ^KBAP("SAMIHL7","UPDTPTL1","C")="" "RTN","SAMIHL7",59,0) ; "RTN","SAMIHL7",60,0) ; If a new patient get the next ptien to use and set dfn "RTN","SAMIHL7",61,0) if '$get(ptien) do "RTN","SAMIHL7",62,0) . set ptien=$order(@rootpl@(999999999),-1)+1 "RTN","SAMIHL7",63,0) . set fields("dfn")=ptien "RTN","SAMIHL7",64,0) . set newpat=1 "RTN","SAMIHL7",65,0) ; "RTN","SAMIHL7",66,0) ; "RTN","SAMIHL7",67,0) set ^KBAP("SAMIHL7","UPDTPTL1","D")="" "RTN","SAMIHL7",68,0) ; "RTN","SAMIHL7",69,0) set ^KBAP("SAMIHL7","ptien","newpat")=$get(ptien)_"^"_$get(newpat) "RTN","SAMIHL7",70,0) set ^KBAP("SAMIHL7","fields(dfn)")=$get(fields("dfn")) "RTN","SAMIHL7",71,0) ; "RTN","SAMIHL7",72,0) ; bail if for some reason we didn't get a next patient ien "RTN","SAMIHL7",73,0) quit:'ptien "RTN","SAMIHL7",74,0) ; "RTN","SAMIHL7",75,0) merge ^KBAP("SAMIHL7","fields")=fields "RTN","SAMIHL7",76,0) set ^KBAP("SAMIHL7","ptien")=$get(ptien) "RTN","SAMIHL7",77,0) ; "RTN","SAMIHL7",78,0) ; "RTN","SAMIHL7",79,0) ; Build MATCHLOG "RTN","SAMIHL7",80,0) ; If we are adding a new patient check whether we had a "RTN","SAMIHL7",81,0) ; match for ssn or name on an existing patient (with "RTN","SAMIHL7",82,0) ; precedence to the ssn). If so set MATCHLOG equal "RTN","SAMIHL7",83,0) ; to the new patient ien and add the index to the "RTN","SAMIHL7",84,0) ; previously existing patient. "RTN","SAMIHL7",85,0) MATCHLOG new newptien,var set newptien="" "RTN","SAMIHL7",86,0) if newpat do "RTN","SAMIHL7",87,0) . set newptien=ptien ; ien of the new patient being added "RTN","SAMIHL7",88,0) .; "RTN","SAMIHL7",89,0) .; if there were 1 or more existing entries with this ssn, set MATCHLOG "RTN","SAMIHL7",90,0) .; "RTN","SAMIHL7",91,0) . if ptienssn do quit "RTN","SAMIHL7",92,0) .. new ssnien s ssnien=0 "RTN","SAMIHL7",93,0) .. for s ssnien=$order(@rootpl@("ssn",$get(fields("ssn")),ssnien)) q:'ssnien d "RTN","SAMIHL7",94,0) ... set @rootpl@(ssnien,"HL7MATCHLOG")=newptien "RTN","SAMIHL7",95,0) ... set @rootpl@("HL7MATCHLOG",ssnien,newptien)="" "RTN","SAMIHL7",96,0) ... U $P write !,"HL7MATCHLOG ssn","--- ssnien=",ssnien,"--- newptien=",newptien "RTN","SAMIHL7",97,0) .; "RTN","SAMIHL7",98,0) .; if there were 1 or more existing entries with this patient name, set MATCHLOG "RTN","SAMIHL7",99,0) .; "RTN","SAMIHL7",100,0) . if ptiennm do "RTN","SAMIHL7",101,0) .. new pnien s pnien=0 "RTN","SAMIHL7",102,0) .. for s pnien=$order(@rootpl@("name",$get(fields("saminame")),pnien)) q:'pnien d "RTN","SAMIHL7",103,0) ... set @rootpl@(pnien,"HL7MATCHLOG")=newptien "RTN","SAMIHL7",104,0) ... set @rootpl@("HL7MATCHLOG",pnien,newptien)="" "RTN","SAMIHL7",105,0) ... U $P write !,"HL7MATCHLOG name","---",pnien "RTN","SAMIHL7",106,0) ; "RTN","SAMIHL7",107,0) ; "RTN","SAMIHL7",108,0) new field s field="" "RTN","SAMIHL7",109,0) ; run through every fields subscript and set the "RTN","SAMIHL7",110,0) ; appropriate subscript patient entry in patient-lookup "RTN","SAMIHL7",111,0) for set field=$order(fields(field)) q:field="" do "RTN","SAMIHL7",112,0) .; "RTN","SAMIHL7",113,0) .;new patient ==================================== "RTN","SAMIHL7",114,0) .; if new patient just set all patient-lookup field with "RTN","SAMIHL7",115,0) .; the data in field array "RTN","SAMIHL7",116,0) .; "RTN","SAMIHL7",117,0) . if newpat do "RTN","SAMIHL7",118,0) .. set @rootpl@(ptien,field)=fields(field) "RTN","SAMIHL7",119,0) .; "RTN","SAMIHL7",120,0) .;old patient ==================================== "RTN","SAMIHL7",121,0) .; if not a new patient only store field results that are NOT null. "RTN","SAMIHL7",122,0) .; Never overwrite an existing patient's "dfn", rather store "RTN","SAMIHL7",123,0) .; the dfn just received in the remotedfn field "RTN","SAMIHL7",124,0) .; "RTN","SAMIHL7",125,0) .; With existing patients if the new data for a field doesn't match "RTN","SAMIHL7",126,0) .; the pre-existing, save the pre-existing data in a changelog entry "RTN","SAMIHL7",127,0) .; "RTN","SAMIHL7",128,0) . if '$get(newpat),'(fields(field)="") do "RTN","SAMIHL7",129,0) .. if field="dfn" quit "RTN","SAMIHL7",130,0) ..; "RTN","SAMIHL7",131,0) .. if '($get(@rootpl@(ptien,field))=fields(field)) do "RTN","SAMIHL7",132,0) ... set @rootpl@(ptien,"hl7changelog",$$FMTE^XLFDT($$NOW^XLFDT,5),field)=fields(field) "RTN","SAMIHL7",133,0) .. set @rootpl@(ptien,field)=fields(field) "RTN","SAMIHL7",134,0) .; "RTN","SAMIHL7",135,0) .;indicies ========================================= "RTN","SAMIHL7",136,0) .;set all indicies for old and new patients for this field "RTN","SAMIHL7",137,0) .; NOTE: we must kill any existing earlier idicies on previously "RTN","SAMIHL7",138,0) .; existing patients to prevent duplicate pointers "RTN","SAMIHL7",139,0) .; "RTN","SAMIHL7",140,0) . if fields(field)="" quit "RTN","SAMIHL7",141,0) .; "RTN","SAMIHL7",142,0) .; field=dfn ===================================== "RTN","SAMIHL7",143,0) . if field="dfn" do "RTN","SAMIHL7",144,0) .. if newpat do "RTN","SAMIHL7",145,0) ... set @rootpl@("dfn",fields(field),ptien)="" "RTN","SAMIHL7",146,0) ..; "RTN","SAMIHL7",147,0) .; As DID NOT get DFN from the VA server (only ssn) "RTN","SAMIHL7",148,0) .; we cannot set the "remotedfn" field "RTN","SAMIHL7",149,0) . set @rootpl@(ptien,"remotedfn")="" "RTN","SAMIHL7",150,0) .; "RTN","SAMIHL7",151,0) .; field=icn ===================================== "RTN","SAMIHL7",152,0) . if field="icn" do "RTN","SAMIHL7",153,0) .. set @rootpl@("icn",fields(field),ptien)="" "RTN","SAMIHL7",154,0) .; "RTN","SAMIHL7",155,0) .; field=last5 =================================== "RTN","SAMIHL7",156,0) . if field="last5" do "RTN","SAMIHL7",157,0) .. if '$get(newpat) do KILLREF(field,$get(oldarr(field)),ptien) "RTN","SAMIHL7",158,0) .. set @rootpl@("last5",fields(field),ptien)="" quit "RTN","SAMIHL7",159,0) .; "RTN","SAMIHL7",160,0) .; field=saminame ================================ "RTN","SAMIHL7",161,0) . if field="saminame" do "RTN","SAMIHL7",162,0) .. if '$get(newpat) do "RTN","SAMIHL7",163,0) ... do KILLREF(field,$get(oldarr(field)),ptien) "RTN","SAMIHL7",164,0) ... do KILLREF("name",$get(oldarr("name")),ptien) "RTN","SAMIHL7",165,0) ... do KILLREF("name",$$UP^XLFSTR($get(oldarr("name"))),ptien) "RTN","SAMIHL7",166,0) .. set @rootpl@("name",fields(field),ptien)="" "RTN","SAMIHL7",167,0) .. set @rootpl@("name",$$UP^XLFSTR(fields(field)),ptien)="" "RTN","SAMIHL7",168,0) .; "RTN","SAMIHL7",169,0) .; field=sinamef ================================== "RTN","SAMIHL7",170,0) . if field="sinamef" do "RTN","SAMIHL7",171,0) .. i '$get(newpat) do KILLREF(field,$get(oldarr(field)),ptien) "RTN","SAMIHL7",172,0) .. set @rootpl@(field,fields(field),ptien)="" "RTN","SAMIHL7",173,0) .; "RTN","SAMIHL7",174,0) .; field=sinamel ================================== "RTN","SAMIHL7",175,0) . if field="sinamel" do "RTN","SAMIHL7",176,0) .. if '$get(newpat) do KILLREF(field,$get(oldarr(field)),ptien) "RTN","SAMIHL7",177,0) .. set @rootpl@(field,fields(field),ptien)="" "RTN","SAMIHL7",178,0) .; "RTN","SAMIHL7",179,0) .; field=ssn ====================================== "RTN","SAMIHL7",180,0) . if field="ssn" do "RTN","SAMIHL7",181,0) .. if '$get(newpat) do KILLREF(field,$get(oldarr(field)),ptien) "RTN","SAMIHL7",182,0) .. set @rootpl@(field,fields(field),ptien)="" "RTN","SAMIHL7",183,0) ; "RTN","SAMIHL7",184,0) ; "RTN","SAMIHL7",185,0) set @rootpl@("Date Last Updated")=$$HTE^XLFDT($horolog) "RTN","SAMIHL7",186,0) ; "RTN","SAMIHL7",187,0) ; set so SAMIORM can use ptien to file HL7 messages "RTN","SAMIHL7",188,0) set fields("ptien")=$get(ptien) "RTN","SAMIHL7",189,0) merge ^KBAP("SAMIHL7","fields")=fields "RTN","SAMIHL7",190,0) ; "RTN","SAMIHL7",191,0) quit "RTN","SAMIHL7",192,0) ; "RTN","SAMIHL7",193,0) ; "RTN","SAMIHL7",194,0) KILLREF(field,oldrslt,ptien) ; "RTN","SAMIHL7",195,0) quit:($get(oldrslt)="") "RTN","SAMIHL7",196,0) kill @rootpl@(field,oldrslt,ptien) "RTN","SAMIHL7",197,0) quit "RTN","SAMIHL7",198,0) ; "RTN","SAMIHL7",199,0) ; "RTN","SAMIHL7",200,0) ; "RTN","SAMIHL7",201,0) ;@ppi "RTN","SAMIHL7",202,0) ;@input "RTN","SAMIHL7",203,0) ; Expects all HL7 variables captured on message reception to "RTN","SAMIHL7",204,0) ; be in environment "RTN","SAMIHL7",205,0) ;@output "RTN","SAMIHL7",206,0) ; Sends com ACK through appropriate link "RTN","SAMIHL7",207,0) ACK ;Force a com ACK "RTN","SAMIHL7",208,0) ; "RTN","SAMIHL7",209,0) kill HLA("HLA") "RTN","SAMIHL7",210,0) set HLA("HLA",1)="MSA"_HLREC("FS")_"CA"_HLREC("FS")_HLREC("MID") "RTN","SAMIHL7",211,0) ; "RTN","SAMIHL7",212,0) I $D(HLA("HLA")) S HLP("NAMESPACE")="HL" D quit "RTN","SAMIHL7",213,0) . merge ^KBAP("SAMIHL7","HLA")=HLA "RTN","SAMIHL7",214,0) . D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.HLMTIENA,"",.HLP) "RTN","SAMIHL7",215,0) ; "RTN","SAMIHL7",216,0) ; "RTN","SAMIHL7",217,0) EOR ;End of routine SAMIHL7 "RTN","SAMIORM") 0^1^B47358865 "RTN","SAMIORM",1,0) SAMIORM ;ven/arc/lgc - parse ORM to update patient-lookup graph ;Jun 02, 2020@18:35 "RTN","SAMIORM",2,0) ;;18.0;SAMI;;;Build 3 "RTN","SAMIORM",3,0) ; "RTN","SAMIORM",4,0) quit ; No entry from top "RTN","SAMIORM",5,0) ; "RTN","SAMIORM",6,0) ;@license: see routine SAMIUL "RTN","SAMIORM",7,0) ; "RTN","SAMIORM",8,0) ; @section 0 primary development "RTN","SAMIORM",9,0) ; "RTN","SAMIORM",10,0) ; @routine-credits "RTN","SAMIORM",11,0) ; @primary-dev: "RTN","SAMIORM",12,0) ; Alexis Carlson (arc) "RTN","SAMIORM",13,0) ; alexis.carlson@vistaexpertise.net "RTN","SAMIORM",14,0) ; Larry "poo" Carlson (lgc) "RTN","SAMIORM",15,0) ; larry@fiscientific.com "RTN","SAMIORM",16,0) ; @primary-dev-org: Vista Expertise Network (ven) "RTN","SAMIORM",17,0) ; http://vistaexpertise.net "RTN","SAMIORM",18,0) ; @copyright: 2012/2018, ven, all rights reserved "RTN","SAMIORM",19,0) ; @license: Apache 2.0 "RTN","SAMIORM",20,0) ; https://www.apache.org/licenses/LICENSE-2.0.html "RTN","SAMIORM",21,0) ; "RTN","SAMIORM",22,0) ; @last-updated: 2019-07-31T16:56Z "RTN","SAMIORM",23,0) ; @application: SAMI "RTN","SAMIORM",24,0) ; @version: 18.0 "RTN","SAMIORM",25,0) ; @patch-list: none yet "RTN","SAMIORM",26,0) ; "RTN","SAMIORM",27,0) ; @to-do "RTN","SAMIORM",28,0) ; Add label comments "RTN","SAMIORM",29,0) ; "RTN","SAMIORM",30,0) ; @change-log "RTN","SAMIORM",31,0) ; "RTN","SAMIORM",32,0) ; @section 1 code "RTN","SAMIORM",33,0) ; "RTN","SAMIORM",34,0) ; "RTN","SAMIORM",35,0) quit ; No entry from top "RTN","SAMIORM",36,0) ; "RTN","SAMIORM",37,0) ; "RTN","SAMIORM",38,0) ; "RTN","SAMIORM",39,0) EN ; Primary entry point "RTN","SAMIORM",40,0) ; "RTN","SAMIORM",41,0) kill ^KBAP("SAMIORM") "RTN","SAMIORM",42,0) set ^KBAP("SAMIORM","EN")=$$HTFM^XLFDT($H)_" TEST" "RTN","SAMIORM",43,0) ; "RTN","SAMIORM",44,0) kill ^TMP("SAMI","ORM") "RTN","SAMIORM",45,0) ; "RTN","SAMIORM",46,0) ; Immediately return COMM ACK "RTN","SAMIORM",47,0) do ACK^SAMIHL7 "RTN","SAMIORM",48,0) ; "RTN","SAMIORM",49,0) ; "RTN","SAMIORM",50,0) BLDARR ; pull out message into array "RTN","SAMIORM",51,0) ; "RTN","SAMIORM",52,0) new HLARR,cnt,samihl7 "RTN","SAMIORM",53,0) for xecute HLNEXT quit:$get(HLNODE)="" do "RTN","SAMIORM",54,0) . set cnt=$get(cnt)+1 "RTN","SAMIORM",55,0) . set HLARR(cnt)=HLNODE "RTN","SAMIORM",56,0) . set samihl7(cnt)=HLNODE "RTN","SAMIORM",57,0) ; "RTN","SAMIORM",58,0) kill ^KBAP("SAMIORM","BLDARR") "RTN","SAMIORM",59,0) merge ^KBAP("SAMIORM","BLDARR","HLARR")=HLARR "RTN","SAMIORM",60,0) ; "RTN","SAMIORM",61,0) DEBUG ;do ^ZTER "RTN","SAMIORM",62,0) ; "RTN","SAMIORM",63,0) new fields "RTN","SAMIORM",64,0) new INFS set INFS=$G(HL("FS")) "RTN","SAMIORM",65,0) new INCC set INCC=$E($G(HL("ECH"))) "RTN","SAMIORM",66,0) do PARSEMSG(.HLARR,.fields) "RTN","SAMIORM",67,0) ; "RTN","SAMIORM",68,0) merge ^KBAP("SAMIORM","samihl7")=samihl7 "RTN","SAMIORM",69,0) ; "RTN","SAMIORM",70,0) ; update patient-lookup graph "RTN","SAMIORM",71,0) do UPDTPTL^SAMIHL7(.fields) "RTN","SAMIORM",72,0) ; "RTN","SAMIORM",73,0) merge ^KBAP("SAMIORM","fields")=fields "RTN","SAMIORM",74,0) ; "RTN","SAMIORM",75,0) ; At this point the fields have been filed in the patient "RTN","SAMIORM",76,0) ; with ptien into the patient lookup graph. "RTN","SAMIORM",77,0) ; I have the ptien in fields("ptien") and I have the HL7 "RTN","SAMIORM",78,0) ; message segments in samihl7 "RTN","SAMIORM",79,0) ; Time to file the message into patient lookup "RTN","SAMIORM",80,0) new ptien set ptien=$get(fields("ptien")) "RTN","SAMIORM",81,0) if ptien do "RTN","SAMIORM",82,0) . new rootpl,hl7cnt,cnt,seg "RTN","SAMIORM",83,0) . set rootpl=$$setroot^%wd("patient-lookup") "RTN","SAMIORM",84,0) . set hl7cnt=$get(@rootpl@(ptien,"hl7 counter"))+1 "RTN","SAMIORM",85,0) . set @rootpl@(ptien,"hl7 counter")=hl7cnt "RTN","SAMIORM",86,0) . set cnt=0 "RTN","SAMIORM",87,0) . for set cnt=$order(samihl7(cnt)) quit:'cnt do "RTN","SAMIORM",88,0) .. set seg=$extract(samihl7(cnt),1,3) "RTN","SAMIORM",89,0) .. set @rootpl@(ptien,"hl7",hl7cnt,seg)=samihl7(cnt) "RTN","SAMIORM",90,0) ; "RTN","SAMIORM",91,0) quit ; End entry point EN "RTN","SAMIORM",92,0) ; "RTN","SAMIORM",93,0) ; "RTN","SAMIORM",94,0) PARSEMSG(HLARR,fields) ; Pull patient data from ORM message "RTN","SAMIORM",95,0) new cnt s cnt=0 "RTN","SAMIORM",96,0) for set cnt=$order(HLARR(cnt)) quit:'cnt do "RTN","SAMIORM",97,0) . set segment=HLARR(cnt) "RTN","SAMIORM",98,0) . new SEG set SEG=$piece(HLARR(cnt),HL("FS")) "RTN","SAMIORM",99,0) . if SEG="PID" do PID(HLARR(cnt),.fields) "RTN","SAMIORM",100,0) . if SEG="PV1" do PV1(HLARR(cnt),.fields) "RTN","SAMIORM",101,0) . if SEG="ORC" do ORC(HLARR(cnt),.fields) "RTN","SAMIORM",102,0) . if SEG="OBR" do OBR(HLARR(cnt),.fields) "RTN","SAMIORM",103,0) quit "RTN","SAMIORM",104,0) ; "RTN","SAMIORM",105,0) ; "RTN","SAMIORM",106,0) PID(segment,fields) ; "RTN","SAMIORM",107,0) new name,fname,lname,mname "RTN","SAMIORM",108,0) set fields("icn")="" "RTN","SAMIORM",109,0) set fields("ssn")=$piece($piece(segment,INFS,4),INCC) "RTN","SAMIORM",110,0) ; "RTN","SAMIORM",111,0) set name=$piece(segment,INFS,6) "RTN","SAMIORM",112,0) set lname=$$CAMELCAS($piece(name,INCC,1)) "RTN","SAMIORM",113,0) set fname=$$CAMELCAS($piece(name,INCC,2)) "RTN","SAMIORM",114,0) set mname="" "RTN","SAMIORM",115,0) if $length($piece(segment,INFS,6),INCC)>2 do "RTN","SAMIORM",116,0) . set mname=$$CAMELCAS($piece($piece(segment,INFS,6),INCC,3)) "RTN","SAMIORM",117,0) ; "RTN","SAMIORM",118,0) set name=lname_","_fname "RTN","SAMIORM",119,0) if $length(mname) do "RTN","SAMIORM",120,0) . set name=name_" "_mname "RTN","SAMIORM",121,0) set fields("saminame")=name "RTN","SAMIORM",122,0) set fields("sinamef")=$piece(name,",",2) "RTN","SAMIORM",123,0) set fields("sinamel")=$piece(name,",") "RTN","SAMIORM",124,0) ; "RTN","SAMIORM",125,0) if $length(fields("ssn")),$length(fields("saminame")) do "RTN","SAMIORM",126,0) . set fields("last5")=$$UP^XLFSTR($extract(fields("saminame")))_$extract(fields("ssn"),6,9) "RTN","SAMIORM",127,0) . set ^KBAP("SAMIORM","MadeLast5")=$get(fields("last5")) "RTN","SAMIORM",128,0) ; "RTN","SAMIORM",129,0) ; convert HL7 date to mm/dd/yyyy "RTN","SAMIORM",130,0) new hl7dob,mnth,day,yr "RTN","SAMIORM",131,0) set hl7dob=$piece(segment,INFS,8) "RTN","SAMIORM",132,0) set mnth=+$e(hl7dob,5,6) "RTN","SAMIORM",133,0) set day=+$e(hl7dob,7,8) "RTN","SAMIORM",134,0) set yr=$e(hl7dob,1,4) "RTN","SAMIORM",135,0) if $get(hl7dob) do "RTN","SAMIORM",136,0) . set fields("sbdob")=mnth_"/"_day_"/"_yr "RTN","SAMIORM",137,0) ; "RTN","SAMIORM",138,0) set fields("sex")=$piece(segment,INFS,9) "RTN","SAMIORM",139,0) set fields("address1")=$piece($piece(segment,INFS,12),INCC) "RTN","SAMIORM",140,0) set fields("city")=$piece($piece(segment,INFS,12),INCC,3) "RTN","SAMIORM",141,0) set fields("state")=$piece($piece(segment,INFS,12),INCC,4) "RTN","SAMIORM",142,0) set fields("zip")=$piece($piece(segment,INFS,12),INCC,5) "RTN","SAMIORM",143,0) set fields("phone")=$piece(segment,INFS,14) "RTN","SAMIORM",144,0) ;set fields("ssn")=$piece(segment,INFS,20) "RTN","SAMIORM",145,0) quit "RTN","SAMIORM",146,0) ; "RTN","SAMIORM",147,0) PV1(segment,fields) ; "RTN","SAMIORM",148,0) set fields("ORMPV1patientclass")=$piece(segment,INFS,3) "RTN","SAMIORM",149,0) set fields("ORMPV1assignedlocation")=$piece(segment,INFS,4) "RTN","SAMIORM",150,0) set fields("ORMPV1providerien")=$piece($piece(segment,INFS,9),INCC) "RTN","SAMIORM",151,0) set fields("ORMPV1providernm")=$tr($piece($piece(segment,INFS,9),INCC,2,4),"^",",") "RTN","SAMIORM",152,0) quit "RTN","SAMIORM",153,0) ; "RTN","SAMIORM",154,0) ORC(segment,fields) ; "RTN","SAMIORM",155,0) set fields("ORMORCordercontrol")=$piece(segment,INFS,2) "RTN","SAMIORM",156,0) set fields("ORMORCordernumber")=$piece(segment,INFS,3) "RTN","SAMIORM",157,0) set fields("ORMORCorderstatus")=$piece(segment,INFS,6) "RTN","SAMIORM",158,0) set fields("ORMORCtransactiondt")=$piece(segment,INFS,10) "RTN","SAMIORM",159,0) set fields("ORMORCordereffectivedt")=$piece(segment,INFS,16) "RTN","SAMIORM",160,0) quit "RTN","SAMIORM",161,0) ; "RTN","SAMIORM",162,0) OBR(segment,fields) ; "RTN","SAMIORM",163,0) set fields("ORMOBRorder")=$piece($piece(segment,INFS,5),INCC) "RTN","SAMIORM",164,0) set fields("siteid")=$piece($piece($piece(segment,INFS,5),INCC),"_") "RTN","SAMIORM",165,0) set fields("ORMOBRorder2")=$piece($piece(segment,INFS,5),INCC,2) "RTN","SAMIORM",166,0) quit "RTN","SAMIORM",167,0) ; "RTN","SAMIORM",168,0) ; "RTN","SAMIORM",169,0) CAMELCAS(str) ; "RTN","SAMIORM",170,0) if $get(str)="" quit str "RTN","SAMIORM",171,0) set str=$$LOW^XLFSTR(str) "RTN","SAMIORM",172,0) set str=$$UP^XLFSTR($extract(str,1))_$extract(str,2,$length(str)) "RTN","SAMIORM",173,0) quit str "RTN","SAMIORM",174,0) ; "RTN","SAMIORM",175,0) TEST K HLARR "RTN","SAMIORM",176,0) set HLARR(1)="MSH|^~\&|MCAR-INST|VISTA|INST-MCAR|VAPALS|202005250950-0700||ORM^O01|9990000512|P|2.3|||||USA" "RTN","SAMIORM",177,0) set HLARR(2)="PID|1||000000199||ZZTESTPATIENT^JAN^^^^^L||19990101000000|F|||123 NOWHERE LANE^^PHOENIX^AZ^85012||||||||000000199|" "RTN","SAMIORM",178,0) set HLARR(3)="PV1||O|PHX-PULM RN LSS PHONE|||||244088^GARCIA^DANIEL^P" "RTN","SAMIORM",179,0) set HLARR(4)="ORC|NW|3200522142122|||NW||||20200522142122||||||20200522143000" "RTN","SAMIORM",180,0) set HLARR(5)="OBR||||LUNG^LUNG|" "RTN","SAMIORM",181,0) quit "RTN","SAMIORM",182,0) ; "RTN","SAMIORM",183,0) EOR ; End of routine SAMIORM "VER") 8.0^22.2 **END** **END**