Released RA*5*107 SEQ #99 Extracted from mail message **KIDS**:RA*5.0*107^ **INSTALL NAME** RA*5.0*107 "BLD",7848,0) RA*5.0*107^RADIOLOGY/NUCLEAR MEDICINE^0^3111122^y "BLD",7848,1,0) ^^3^3^3111122^^^^ "BLD",7848,1,1,0) Patch one hundred and seven for the VistA Radiology/Nuclear Medicine 5.0 "BLD",7848,1,2,0) application. Please review FORUM's Patch Module description and "BLD",7848,1,3,0) installation instructions for RA*5.0*107 before installing this patch. "BLD",7848,4,0) ^9.64PA^^0 "BLD",7848,6.3) 2 "BLD",7848,"ABPKG") n "BLD",7848,"INIT") "BLD",7848,"KRN",0) ^9.67PA^779.2^20 "BLD",7848,"KRN",.4,0) .4 "BLD",7848,"KRN",.4,"NM",0) ^9.68A^^0 "BLD",7848,"KRN",.401,0) .401 "BLD",7848,"KRN",.402,0) .402 "BLD",7848,"KRN",.402,"NM",0) ^9.68A^^0 "BLD",7848,"KRN",.403,0) .403 "BLD",7848,"KRN",.5,0) .5 "BLD",7848,"KRN",.84,0) .84 "BLD",7848,"KRN",3.6,0) 3.6 "BLD",7848,"KRN",3.8,0) 3.8 "BLD",7848,"KRN",9.2,0) 9.2 "BLD",7848,"KRN",9.8,0) 9.8 "BLD",7848,"KRN",9.8,"NM",0) ^9.68A^4^3 "BLD",7848,"KRN",9.8,"NM",2,0) RAHL24Q^^0^B17508754 "BLD",7848,"KRN",9.8,"NM",3,0) RAHL24U^^0^B179243251 "BLD",7848,"KRN",9.8,"NM",4,0) RAHL23Q^^0^B135675772 "BLD",7848,"KRN",9.8,"NM","B","RAHL23Q",4) "BLD",7848,"KRN",9.8,"NM","B","RAHL24Q",2) "BLD",7848,"KRN",9.8,"NM","B","RAHL24U",3) "BLD",7848,"KRN",19,0) 19 "BLD",7848,"KRN",19.1,0) 19.1 "BLD",7848,"KRN",101,0) 101 "BLD",7848,"KRN",409.61,0) 409.61 "BLD",7848,"KRN",771,0) 771 "BLD",7848,"KRN",779.2,0) 779.2 "BLD",7848,"KRN",779.2,"NM",0) ^9.68A^2^2 "BLD",7848,"KRN",779.2,"NM",1,0) RA-NTP-QRY-CLIENT^^0 "BLD",7848,"KRN",779.2,"NM",2,0) RA-NTP-QRY-SERVER^^0 "BLD",7848,"KRN",779.2,"NM","B","RA-NTP-QRY-CLIENT",1) "BLD",7848,"KRN",779.2,"NM","B","RA-NTP-QRY-SERVER",2) "BLD",7848,"KRN",870,0) 870 "BLD",7848,"KRN",8989.51,0) 8989.51 "BLD",7848,"KRN",8989.52,0) 8989.52 "BLD",7848,"KRN",8994,0) 8994 "BLD",7848,"KRN","B",.4,.4) "BLD",7848,"KRN","B",.401,.401) "BLD",7848,"KRN","B",.402,.402) "BLD",7848,"KRN","B",.403,.403) "BLD",7848,"KRN","B",.5,.5) "BLD",7848,"KRN","B",.84,.84) "BLD",7848,"KRN","B",3.6,3.6) "BLD",7848,"KRN","B",3.8,3.8) "BLD",7848,"KRN","B",9.2,9.2) "BLD",7848,"KRN","B",9.8,9.8) "BLD",7848,"KRN","B",19,19) "BLD",7848,"KRN","B",19.1,19.1) "BLD",7848,"KRN","B",101,101) "BLD",7848,"KRN","B",409.61,409.61) "BLD",7848,"KRN","B",771,771) "BLD",7848,"KRN","B",779.2,779.2) "BLD",7848,"KRN","B",870,870) "BLD",7848,"KRN","B",8989.51,8989.51) "BLD",7848,"KRN","B",8989.52,8989.52) "BLD",7848,"KRN","B",8994,8994) "BLD",7848,"QUES",0) ^9.62^^ "BLD",7848,"REQB",0) ^9.611^3^3 "BLD",7848,"REQB",1,0) RA*5.0*47^2 "BLD",7848,"REQB",2,0) MAG*3.0*49^2 "BLD",7848,"REQB",3,0) RA*5.0*78^2 "BLD",7848,"REQB","B","MAG*3.0*49",2) "BLD",7848,"REQB","B","RA*5.0*47",1) "BLD",7848,"REQB","B","RA*5.0*78",3) "KRN",779.2,15,-1) 0^1 "KRN",779.2,15,0) RA-NTP-QRY-CLIENT "KRN",779.2,15,1,0) ^779.21I^^0 "KRN",779.2,15,2) RADIOLOGY/NUCLEAR MEDICINE "KRN",779.2,16,-1) 0^2 "KRN",779.2,16,0) RA-NTP-QRY-SERVER "KRN",779.2,16,1,0) ^779.21I^1^1 "KRN",779.2,16,1,1,0) QBP^Q11^RA-NTP-QRY-SERVER^SRV^RAHL24Q^2.4 "KRN",779.2,16,1,"B","QBP",1) "KRN",779.2,16,1,"D","QBP","Q11",2.4,1) "KRN",779.2,16,2) RADIOLOGY/NUCLEAR MEDICINE "MBREQ") 0 "ORD",22,779.2) 779.2;22;1;;HLOAP^XPDTA1;;HLOE^XPDIA1;;; "ORD",22,779.2,0) HLO APPLICATION REGISTRY "PKG",18,-1) 1^1 "PKG",18,0) RADIOLOGY/NUCLEAR MEDICINE^RA^REGISTERS PATIENTS,RECORDS EXAMS,PROFILES,AMIS REPORTS "PKG",18,20,0) ^9.402P^^ "PKG",18,22,0) ^9.49I^1^1 "PKG",18,22,1,0) 5.0^3051109^2980407^50 "PKG",18,22,1,"PAH",1,0) 107^3111122 "PKG",18,22,1,"PAH",1,1,0) ^^3^3^3111122 "PKG",18,22,1,"PAH",1,1,1,0) Patch one hundred and seven for the VistA Radiology/Nuclear Medicine 5.0 "PKG",18,22,1,"PAH",1,1,2,0) application. Please review FORUM's Patch Module description and "PKG",18,22,1,"PAH",1,1,3,0) installation instructions for RA*5.0*107 before installing this patch. "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") 3 "RTN","RAHL23Q") 0^4^B135675772^B131709576 "RTN","RAHL23Q",1,0) RAHL23Q ;HINES OIFO/GJC process query message/event type (QRY/R02) ; 15 Aug 2008 2:27 PM "RTN","RAHL23Q",2,0) ;;5.0;Radiology/Nuclear Medicine;**78,107**;Mar 16, 1998;Build 2 "RTN","RAHL23Q",3,0) ; "RTN","RAHL23Q",4,0) ;Integration Agreements "RTN","RAHL23Q",5,0) ;---------------------- "RTN","RAHL23Q",6,0) ;%ZTLOAD(10063), $$FIND1^DIC(2051), $$NEWMSG^HLOAPI(4716), $$SENDONE^HLOAPI1(4717) "RTN","RAHL23Q",7,0) ;$$GET^HLOPRS(4718), $$NEXTSEG^HLOPRS(4718), $$STARTMSG^HLOPRS(4718), $$FMADD^XLFDT(10103) "RTN","RAHL23Q",8,0) ;$$HL7TFM^XLFDT(10103), $$NOW^XLFDT(10103), XMD(10070) "RTN","RAHL23Q",9,0) ; "RTN","RAHL23Q",10,0) RCVQRY ;receive & process the inbound query "RTN","RAHL23Q",11,0) S:$G(U)'="^" U="^" ;under development "RTN","RAHL23Q",12,0) N HL,HLA,HLSTART,RAQFC,RAQPRI,RAQID,RAQDRT,RAQDRDT,RAQWHO,RAQWHAT,RAQDEPT "RTN","RAHL23Q",13,0) N RAQWHERE,RAQSTRT,RAQEND,RAQUANT,RAQUNIT "RTN","RAHL23Q",14,0) N RACNTRL,RACS,RADFN,RAECH,RAEDT,RAEND,RAERR,RAESC,RAFS,RAI,RAJ,RAK,RAMSH,RAPRIO,RARPT "RTN","RAHL23Q",15,0) N RARS,RASCS,RASDT,RASEG,RATXT,RAX,RAZDNS "RTN","RAHL23Q",16,0) ;Please be aware that when using HLO the database where the message headers and "RTN","RAHL23Q",17,0) ;message bodies are filed have changed. "RTN","RAHL23Q",18,0) ;legacy VistA HL7 optimized VistA HL7 (HLO) "RTN","RAHL23Q",19,0) ;----------------------------------------------------- "RTN","RAHL23Q",20,0) ;HL7 MESSAGE TEXT (#772) HLO MESSAGE BODY (#777) "RTN","RAHL23Q",21,0) ;HL7 MESSAGE ADMINISTRATION (#773) HLO MESSAGES (#778) "RTN","RAHL23Q",22,0) ; "RTN","RAHL23Q",23,0) MSH ;Parse the header and return individual values "RTN","RAHL23Q",24,0) I '$$STARTMSG^HLOPRS(.HLMSTATE,HLMSGIEN,.RAMSH) D Q "RTN","RAHL23Q",25,0) .S RATXT(1)="Error processing the NTP query used to return radiology results." "RTN","RAHL23Q",26,0) .S RATXT(2)="",RATXT(3)="Contact the VistA Radiology/Nuclear Medicine development team." "RTN","RAHL23Q",27,0) .D ERR(.RATXT) Q "RTN","RAHL23Q",28,0) ; "RTN","RAHL23Q",29,0) ;RAHDR array elements defined "RTN","RAHL23Q",30,0) ;---------------------------- "RTN","RAHL23Q",31,0) ;RAMSH("SEGMENT TYPE")="MSH" RAMSH("DT/TM OF MESSAGE") "RTN","RAHL23Q",32,0) ;RAMSH("FIELD SEPARATOR") RAMSH("SECURITY") "RTN","RAHL23Q",33,0) ;RAMSH("COMPONENT SEPARATOR") RAMSH("MESSAGE TYPE") "RTN","RAHL23Q",34,0) ;RAMSH("SUBCOMPONENT SEPARATOR") RAMSH("EVENT") "RTN","RAHL23Q",35,0) ;RAMSH("REPETITION SEPARATOR") RAMSH("MESSAGE STRUCTURE") "RTN","RAHL23Q",36,0) ;RAMSH("ESCAPE CHARACTER") RAMSH("MESSAGE CONTROL ID") "RTN","RAHL23Q",37,0) ;RAMSH("SENDING APPLICATION") RAMSH("PROCESSING ID") "RTN","RAHL23Q",38,0) ;RAMSH("SENDING FACILITY",1) 1st component RAMSH("PROCESSING MODE") "RTN","RAHL23Q",39,0) ;RAMSH("SENDING FACILITY",2) 2nd component RAMSH("VERSION") "RTN","RAHL23Q",40,0) ;RAMSH("SENDING FACILITY",3) 3rd component RAMSH("CONTINUATION POINTER") "RTN","RAHL23Q",41,0) ;RAMSH("RECEIVING APPLICATION") RAMSH("ACCEPT ACK TYPE") "RTN","RAHL23Q",42,0) ;RAMSH("RECEIVING FACILITY",1) 1st component RAMSH("APP ACK TYPE") "RTN","RAHL23Q",43,0) ;RAMSH("RECEIVING FACILITY",2) 2nd component RAMSH("COUNTRY") "RTN","RAHL23Q",44,0) ;RAMSH("RECEIVING FACILITY",3) 3rd component "RTN","RAHL23Q",45,0) ; "RTN","RAHL23Q",46,0) S RACNTRL=RAMSH("MESSAGE CONTROL ID") "RTN","RAHL23Q",47,0) S RAZDNS=RAMSH("SENDING FACILITY",2) "RTN","RAHL23Q",48,0) ; "RTN","RAHL23Q",49,0) ;perform some sanity checks... "RTN","RAHL23Q",50,0) ; "RTN","RAHL23Q",51,0) I RAMSH("MESSAGE TYPE")'="QRY"!(RAMSH("EVENT")'="R02") D Q "RTN","RAHL23Q",52,0) .N X,X1 "RTN","RAHL23Q",53,0) .S X=$S(RAMSH("MESSAGE TYPE")'="QRY":"HL7 MESSAGE TYPE",1:"HL7 EVENT TYPE") "RTN","RAHL23Q",54,0) .S X1=$S(RAMSH("MESSAGE TYPE")'="QRY":"(QRY)",1:"(R02)") "RTN","RAHL23Q",55,0) .S RATXT(1)="The "_X_" expected "_X1_" differs from the "_X "RTN","RAHL23Q",56,0) .S RATXT(2)="received: "_$S(RAMSH("MESSAGE TYPE")'="QRY":RAMSH("MESSAGE TYPE"),1:RAMSH("MESSAGE TYPE")) "RTN","RAHL23Q",57,0) .S RATXT(3)="",RATXT(4)="Contact the VistA Radiology/Nuclear Medicine development team." "RTN","RAHL23Q",58,0) .S RATXT(5)="",RATXT(6)="MESSAGE CONTROL ID: " "RTN","RAHL23Q",59,0) .D ERR(.RATXT) Q "RTN","RAHL23Q",60,0) ; "RTN","RAHL23Q",61,0) ;namespace other RA* variables to their RAHDR() equivalent (save keys strokes) "RTN","RAHL23Q",62,0) S RAECH=RAMSH("ENCODING CHARACTERS") "RTN","RAHL23Q",63,0) S RAFS=RAMSH("FIELD SEPARATOR") "RTN","RAHL23Q",64,0) S RACS=RAMSH("COMPONENT SEPARATOR") "RTN","RAHL23Q",65,0) S RARS=RAMSH("REPETITION SEPARATOR") "RTN","RAHL23Q",66,0) S RAESC=RAMSH("ESCAPE CHARACTER") "RTN","RAHL23Q",67,0) S RASCS=RAMSH("SUBCOMPONENT SEPARATOR") "RTN","RAHL23Q",68,0) ; "RTN","RAHL23Q",69,0) SEG ;parse the body of the message (segments) "RTN","RAHL23Q",70,0) F Q:'$$NEXTSEG^HLOPRS(.HLMSTATE,.RASEG) D Q:$D(RAERR)#2 "RTN","RAHL23Q",71,0) .;get the fields and set the proper local variables... "RTN","RAHL23Q",72,0) .I $$GET^HLOPRS(.RASEG,RAFS,RACS,RASCS,RARS) "RTN","RAHL23Q",73,0) .;the data is in this format: SEG(FIELD #,REP,COMP,SUBCOMP) "RTN","RAHL23Q",74,0) .D @RASEG(0) "RTN","RAHL23Q",75,0) .Q "RTN","RAHL23Q",76,0) ; "RTN","RAHL23Q",77,0) ;I $D(RAERR)#2 D Q "RTN","RAHL23Q",78,0) ;.S RATXT(1)="Error processing the NTP query used to return radiology results." "RTN","RAHL23Q",79,0) ;.S RATXT(2)="",RATXT(3)="Error: "_$G(RAERR),RATXT(4)="" "RTN","RAHL23Q",80,0) ;.S RATXT(5)="Contact the VistA Radiology/Nuclear Medicine development team." "RTN","RAHL23Q",81,0) ;.D ERR(.RATXT) Q "RTN","RAHL23Q",82,0) ; "RTN","RAHL23Q",83,0) D TASK "RTN","RAHL23Q",84,0) Q "RTN","RAHL23Q",85,0) ; "RTN","RAHL23Q",86,0) QRD ;Analyze data from the QRD segment from Non-VistA System "RTN","RAHL23Q",87,0) ; "RTN","RAHL23Q",88,0) ; Local Variable & value HL7 segment-field "RTN","RAHL23Q",89,0) ;--------------------------------------------------------- "RTN","RAHL23Q",90,0) ;RAQDT = Query Date/Time QRD-1 "RTN","RAHL23Q",91,0) ;RAQFC = Query Format code QRD-2 "RTN","RAHL23Q",92,0) ;RAQPRI = Query Priority QRD-3 "RTN","RAHL23Q",93,0) ;RAQID = Query ID QRD-4 "RTN","RAHL23Q",94,0) ;RAQDRT = Deferred Resp. Type QRD-5 "RTN","RAHL23Q",95,0) ;RAQDRDT = Deferred Resp. Date/Time QRD-6 "RTN","RAHL23Q",96,0) ;RAQUANT = Quantity Limited Request QRD-7 "RTN","RAHL23Q",97,0) ;RAQWHO = Who Subject Filter (patient SSN) QRD-8 "RTN","RAHL23Q",98,0) ;RAQWHAT = What Subject Filter QRD-9 "RTN","RAHL23Q",99,0) ;RAQDEPT = What Dept. Data Code (accession) QRD-10 "RTN","RAHL23Q",100,0) ; "RTN","RAHL23Q",101,0) ;RAQUANT (QRD-7) Quantity Limited Request has two components: 1st=quantity, 2nd=units "RTN","RAHL23Q",102,0) ; "RTN","RAHL23Q",103,0) S RAQDT=$G(RASEG(1,1,1,1)),RAQFC=$G(RASEG(2,1,1,1)),RAQPRI=$G(RASEG(3,1,1,1)) "RTN","RAHL23Q",104,0) S RAQID=$G(RASEG(4,1,1,1)),RAQDRT=$G(RASEG(5,1,1,1)),RAQDRDT=$G(RASEG(6,1,1,1)) "RTN","RAHL23Q",105,0) S RAQUANT=$G(RASEG(7,1,1,1)),RAQUNIT=$G(RASEG(7,1,2,1)),RAQWHO=$G(RASEG(8,1,1,1)) "RTN","RAHL23Q",106,0) S RAQWHAT=$G(RASEG(9,1,1,1)),RAQDEPT=$G(RASEG(10,1,1,1)) "RTN","RAHL23Q",107,0) ; "RTN","RAHL23Q",108,0) S RAQWHO=$TR(RAQWHO,"-","") ;strip out the dashes in the SSN "RTN","RAHL23Q",109,0) ; "RTN","RAHL23Q",110,0) ;We need to know the type of query: patient or accession "RTN","RAHL23Q",111,0) ;RAQDEPT denotes an accession based query; RAQWHO denotes a patient based query "RTN","RAHL23Q",112,0) ;Both query types require QRD-1, QRD-2, QRD-3, QRD-4, QRD-7, & QRD-9 "RTN","RAHL23Q",113,0) ; "RTN","RAHL23Q",114,0) I RAQDT="" S RAERR="Missing Query Date/Time (QRD-1)" Q "RTN","RAHL23Q",115,0) I RAQFC="" S RAERR="Missing Query Format Code (QRD-2)" Q "RTN","RAHL23Q",116,0) I RAQPRI="" S RAERR="Missing Query Priority (QRD-3)" Q "RTN","RAHL23Q",117,0) I RAQID="" S RAERR="Missing Query ID (QRD-4)" Q "RTN","RAHL23Q",118,0) ; "RTN","RAHL23Q",119,0) ;-if the number of reports to return is less than zero default to one "RTN","RAHL23Q",120,0) ;-if the number of reports to return is greater than one hundred default "RTN","RAHL23Q",121,0) ; to one hundred "RTN","RAHL23Q",122,0) S:RAQUANT'>0 RAQUANT=1 S:RAQUANT>1000 RAQUANT=1000 "RTN","RAHL23Q",123,0) ; "RTN","RAHL23Q",124,0) I RAQUNIT="" S RAERR="Missing Quantity Limited Request (units QRD-7.2)" Q "RTN","RAHL23Q",125,0) I RAQWHAT="" S RAERR="Missing What Subject Filter (QRD-9)" Q "RTN","RAHL23Q",126,0) I RAQWHO="",(RAQDEPT="") S RAERR="Indeterminable query type" Q "RTN","RAHL23Q",127,0) I $L(RAQWHO),($L(RAQDEPT)) S RAERR="Indeterminable query type" Q "RTN","RAHL23Q",128,0) ; "RTN","RAHL23Q",129,0) ;Who Subject Filter (passed as a SSN, convert to the DFN of the patient) "RTN","RAHL23Q",130,0) ;I $$FIND1^DIC(2,"","","`"_RAQWHO)'>0 S RAERR="Invalid patient identifier; no match in PATIENT (#2) file" Q "RTN","RAHL23Q",131,0) S RADFN=$$FIND1^DIC(2,,"X",RAQWHO,"SSN") "RTN","RAHL23Q",132,0) I RADFN'>0 S RAERR="Invalid patient SSN identifier; no match in PATIENT (#2) file" "RTN","RAHL23Q",133,0) ; "RTN","RAHL23Q",134,0) ;Note: if RAQUANT=1 then there will be not need to implement "RTN","RAHL23Q",135,0) ;a continuation pointer. "RTN","RAHL23Q",136,0) ; "RTN","RAHL23Q",137,0) Q "RTN","RAHL23Q",138,0) ; "RTN","RAHL23Q",139,0) QRF ;Analyze data from the QRF segment from Non-VistA System "RTN","RAHL23Q",140,0) ; "RTN","RAHL23Q",141,0) ; Local Variable & value HL7 segment-field "RTN","RAHL23Q",142,0) ;-------------------------------------------------------------------------- "RTN","RAHL23Q",143,0) ;RAQWHERE = Where Subject Filter (which department/system) QRF-1 "RTN","RAHL23Q",144,0) ;RAQSTART = When Data Start Date/Time QRF-2 "RTN","RAHL23Q",145,0) ; RAQEND = When Data End Date/Time QRF-3 "RTN","RAHL23Q",146,0) ; "RTN","RAHL23Q",147,0) S RAQWHERE=$G(RASEG(1,1,1,1)),RAQSTART=$G(RASEG(2,1,1,1)),RAQEND=$G(RASEG(3,1,1,1)) "RTN","RAHL23Q",148,0) I RAQWHERE="" S RAERR="Missing Where(department/system) Subject Filter (QRF-1)" Q "RTN","RAHL23Q",149,0) I RAQEND="" S RAERR="Missing When Data End Date/Time (QRF-3)" Q "RTN","RAHL23Q",150,0) ; "RTN","RAHL23Q",151,0) ;A patient based query requires 'When Data Start Date/Time' & 'When Data End Date/Time' data "RTN","RAHL23Q",152,0) ; "RTN","RAHL23Q",153,0) I $G(RADFN),(RAQSTART="") S RAERR="Missing When Data Start Date/Time (QRF-2)" Q "RTN","RAHL23Q",154,0) ;check for valid HL7 date/time data "RTN","RAHL23Q",155,0) ;set RAEDT=FileMan end date & RASDT=FileMan START date "RTN","RAHL23Q",156,0) I $L(RAQSTART) D "RTN","RAHL23Q",157,0) .S RASDT=$E($$HL7TFM^XLFDT(RAQSTART),1,12) ;to the minute... "RTN","RAHL23Q",158,0) .S:RASDT=-1 RAERR="Invalid When Data Start Date/Time (QRF-2)" "RTN","RAHL23Q",159,0) .Q "RTN","RAHL23Q",160,0) S RAEDT=$E($$HL7TFM^XLFDT(RAQEND),1,12) ;to the minute... "RTN","RAHL23Q",161,0) S:RAEDT=-1 RAERR="Invalid When Data End Date/Time (QRF-3)" "RTN","RAHL23Q",162,0) Q "RTN","RAHL23Q",163,0) ; "RTN","RAHL23Q",164,0) TASK ;look up the the results (verified) for a specific patient over a specific time frame "RTN","RAHL23Q",165,0) ;this is a tasked process "RTN","RAHL23Q",166,0) ; "RTN","RAHL23Q",167,0) ;If RADEBUG is defined then DO NOT task off the HL7 message building process fall right "RTN","RAHL23Q",168,0) ;through to the START subroutine. "RTN","RAHL23Q",169,0) ; "RTN","RAHL23Q",170,0) I '($D(RADEBUG)#2) D Q "RTN","RAHL23Q",171,0) .S ZTRTN="START^RAHL23Q",ZTDESC="RA ORF/R04 - return observed radiology results to NTP" "RTN","RAHL23Q",172,0) .S ZTSAVE("RA*")="",ZTIO="",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,0,10) "RTN","RAHL23Q",173,0) .D ^%ZTLOAD "RTN","RAHL23Q",174,0) .Q "RTN","RAHL23Q",175,0) ; "RTN","RAHL23Q",176,0) START ;begin the process of replying to the client side query QRY/R02 "RTN","RAHL23Q",177,0) ; "RTN","RAHL23Q",178,0) ;Identify the type of the client side query "RTN","RAHL23Q",179,0) ;------------------------------------------ "RTN","RAHL23Q",180,0) ; -I $D(RADFN) then the query is patient based (over time; the # results may be capped) "RTN","RAHL23Q",181,0) ; -Else the query is accession based and one result is all that is asked for. "RTN","RAHL23Q",182,0) ; "RTN","RAHL23Q",183,0) ;if there is an error because of the query parameters passed from the "RTN","RAHL23Q",184,0) ;client fire off the negative acknowledgement and exit this process. "RTN","RAHL23Q",185,0) N RACNT S RACNT=0 I $D(RAERR)#2 D NAK,XIT Q "RTN","RAHL23Q",186,0) ;attempt to build the query response. If there are no results to be passed "RTN","RAHL23Q",187,0) ;(RACNT=0) fire off a negative acknowledgement "RTN","RAHL23Q",188,0) I $D(RADFN)#2 D "RTN","RAHL23Q",189,0) .N RACNI,RACONST,RADTE,RADTI,RAIEDT,RAISDT,RARPT,RAESTAT,RAY2,RAY3 S RACONST=9999999.9999 "RTN","RAHL23Q",190,0) .S RAZISDT=$$FMADD^XLFDT(RASDT,0,0,-1,0) ;subtract a minute from the start date "RTN","RAHL23Q",191,0) .S RAZIEDT=(RAEDT\1)+.2359 ;the end date must go to the end of the day "RTN","RAHL23Q",192,0) .S RAISDT=RACONST-RAZISDT,(RADTI,RAIEDT)=RACONST-RAZIEDT K RAZIEDT,RAZISDT "RTN","RAHL23Q",193,0) .F S RADTI=$O(^RADPT(RADFN,"DT",RADTI)) Q:RADTI'>0!(RADTI>RAISDT) D Q:RACNT>RAQUANT "RTN","RAHL23Q",194,0) ..S RACNI=0,RADTE=RACONST-RADTI,RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)) "RTN","RAHL23Q",195,0) ..F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0 D Q:RACNT>RAQUANT "RTN","RAHL23Q",196,0) ...I ($D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))#2) S RAY3=^(0) D "RTN","RAHL23Q",197,0) ....;what is the status of the exam? cancelled exams (RAESTAT=0) are ignored... "RTN","RAHL23Q",198,0) ....S RAESTAT=$P($G(^RA(72,+$P(RAY3,U,3),0)),U,3) Q:RAESTAT=0 "RTN","RAHL23Q",199,0) ....S RARPT=+$P(RAY3,U,17) Q:'RARPT S RARPT(0)=$G(^RARPT(RARPT,0)) "RTN","RAHL23Q",200,0) ....I $P(RARPT(0),U,5)="V" S RACNT=RACNT+1 Q:RACNT>RAQUANT D "RTN","RAHL23Q",201,0) .....D INIT^RAHL23QU,SENDMSG "RTN","RAHL23Q",202,0) .....K RAI,RAY,RAZCPT,RAZDAYCS,RAZPIMG,RAZPRC "RTN","RAHL23Q",203,0) .....Q "RTN","RAHL23Q",204,0) ....Q "RTN","RAHL23Q",205,0) ...Q "RTN","RAHL23Q",206,0) ..Q "RTN","RAHL23Q",207,0) .;I 'RACNT S RAERR="No results are available for this patient" D NAK "RTN","RAHL23Q",208,0) .Q "RTN","RAHL23Q",209,0) E D ;lookup by accession "RTN","RAHL23Q",210,0) .N RACN,RACNI,RACONST,RADFN,RADTE,RAINDX,RARPT,RAX,RAY2,RAY3 "RTN","RAHL23Q",211,0) .;the accession number may be in two formats: "RTN","RAHL23Q",212,0) .;station # prefix-mm/dd/yy-case # -OR- mm/dd/yy-case # "RTN","RAHL23Q",213,0) .;the format identifies the cross-referece we need to look up on "RTN","RAHL23Q",214,0) .S RAX=$L(RAQDEPT,"-"),RACONST=9999999.9999 "RTN","RAHL23Q",215,0) .;if RAX=2 the index is "ADC"; if RAX=3 the index is "ADC1" "RTN","RAHL23Q",216,0) .;if RAX is any other value that set RAERR & QUIT "RTN","RAHL23Q",217,0) .I RAX'=2,(RAX'=3) S RAERR="Invalid Accession Number format" Q "RTN","RAHL23Q",218,0) .; "RTN","RAHL23Q",219,0) .;define the core variables: RADFN, RADTI, & RACNI... "RTN","RAHL23Q",220,0) .S RAINDX=$S(RAX=2:$NA(^RADPT("ADC")),1:$NA(^RADPT("ADC1"))) "RTN","RAHL23Q",221,0) .S RADFN=$O(@RAINDX@(RAQDEPT,0)),RADTI=$O(@RAINDX@(RAQDEPT,RADFN,0)) "RTN","RAHL23Q",222,0) .S RACNI=$O(@RAINDX@(RAQDEPT,RADFN,RADTI,0)) "RTN","RAHL23Q",223,0) .S:RADFN'>0 RAERR="Invalid Accession Number - RADFN" Q:$D(RAERR)#2 "RTN","RAHL23Q",224,0) .S:RADTI'>0 RAERR="Invalid Accession Number - RADTI" Q:$D(RAERR)#2 "RTN","RAHL23Q",225,0) .S:RACNI'>0 RAERR="Invalid Accession Number - RACNI" Q:$D(RAERR)#2 "RTN","RAHL23Q",226,0) .; "RTN","RAHL23Q",227,0) .;build the zero nodes of 70.02 & 70.03 "RTN","RAHL23Q",228,0) .S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)),RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) "RTN","RAHL23Q",229,0) .;get the report pointer... "RTN","RAHL23Q",230,0) .S RARPT=$P(RAY3,U,17) "RTN","RAHL23Q",231,0) .I RARPT="" S RAERR="No report on file for this accession." Q "RTN","RAHL23Q",232,0) .S RARPT(0)=$G(^RARPT(RARPT,0)) "RTN","RAHL23Q",233,0) .I RARPT(0)="" S RAERR="Corrupted record #: "_RARPT_" in RAD/NUC MED REPORTS file." Q "RTN","RAHL23Q",234,0) .I $P(RARPT(0),U,5)'="V" S RAERR="Accession: "_RAQDEPT_" is linked to a non-verified report" Q "RTN","RAHL23Q",235,0) .S RADTE=$P(RARPT(0),U,3),RACN=$P(RARPT(0),U,4) "RTN","RAHL23Q",236,0) .I $P(RARPT(0),U,2)'=RADFN S RAERR="Patient DFN mismatch" Q "RTN","RAHL23Q",237,0) .I (RACONST-RADTI)'=RADTE S RAERR="Exam Date/Time mismatch" Q "RTN","RAHL23Q",238,0) .I $P(RAY3,U)'=RACN S RAERR="Case Number mismatch" Q "RTN","RAHL23Q",239,0) .; "RTN","RAHL23Q",240,0) .S RACNT=RACNT+1 ;will be a max of 1 "RTN","RAHL23Q",241,0) .D INIT^RAHL23QU D SENDMSG "RTN","RAHL23Q",242,0) .K RAZCPT,RAZDAYCS,RAZPIMG,RAZPRC "RTN","RAHL23Q",243,0) .Q "RTN","RAHL23Q",244,0) D XIT "RTN","RAHL23Q",245,0) Q "RTN","RAHL23Q",246,0) ; "RTN","RAHL23Q",247,0) ERR(RATXT) ;inform the radiology users via an email message "RTN","RAHL23Q",248,0) ;that the query was negatively acknowledged. "RTN","RAHL23Q",249,0) ;Input: RATXT=error text as it is displayed to the user "RTN","RAHL23Q",250,0) N XMDUN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ "RTN","RAHL23Q",251,0) S XMY(DUZ)="",XMY("G.RAD HL7 MESSAGES")="",XMDUZ=.5 "RTN","RAHL23Q",252,0) S XMSUB="VistA Radiology HL7 query alert error",XMTEXT="RATXT(" "RTN","RAHL23Q",253,0) S RATXT($O(RATXT($C(32)),-1)+1)="MESSAGE CONTROL ID: "_RACNTRL "RTN","RAHL23Q",254,0) D ^XMD Q "RTN","RAHL23Q",255,0) ; "RTN","RAHL23Q",256,0) XIT ;exit the process. Fire off a negative acknowledgement if necessary. "RTN","RAHL23Q",257,0) S:$D(ZTQUEUED)#2 ZTREQ="@" "RTN","RAHL23Q",258,0) D KILL^XUSCLEAN "RTN","RAHL23Q",259,0) Q "RTN","RAHL23Q",260,0) ; "RTN","RAHL23Q",261,0) NAK ;negatively acknowledge the QRY/R02 client side query "RTN","RAHL23Q",262,0) ;the query is NAK'ed if the variable RAERR is defined. "RTN","RAHL23Q",263,0) ; "RTN","RAHL23Q",264,0) ;first alert the radiology users that a messages was NAK'ed "RTN","RAHL23Q",265,0) S RAERR(1)=RAERR D ERR(.RAERR) K RAERR(1) "RTN","RAHL23Q",266,0) ;then continue on to build & broadcast the NAK'ed "RTN","RAHL23Q",267,0) ; "RTN","RAHL23Q",268,0) SENDMSG ;broadcast the HL7 message. The message/event type is: ORF/R04 "RTN","RAHL23Q",269,0) ;Define the message parameters COUNTRY, FIELD SEPARATOR, & ENCODING CHARACTERS "RTN","RAHL23Q",270,0) ;are set to their default values for self documentation. "RTN","RAHL23Q",271,0) N HLECH,HLFS,HLQ,RAERROR,RAPARAM,RATXT,RAWHO,RAX "RTN","RAHL23Q",272,0) S RAPARAM("COUNTRY")="USA",(HLFS,RAPARAM("FIELD SEPARATOR"))="|",HLQ="" "RTN","RAHL23Q",273,0) S (HLECH,RAPARAM("ENCODING CHARACTERS"))="^~\&",RAPARAM("VERSION")=2.3 "RTN","RAHL23Q",274,0) S RAPARAM("MESSAGE TYPE")="ORF",RAPARAM("EVENT")="R04" "RTN","RAHL23Q",275,0) ; "RTN","RAHL23Q",276,0) ;Create the new message (builds the MSH segment) "RTN","RAHL23Q",277,0) I '$$NEWMSG^HLOAPI(.RAPARAM,.HLMSTATE,.RAERROR) D Q "RTN","RAHL23Q",278,0) .S RATXT(1)="An error occurred in the process of building a "_$S($D(RAERR)#2:"negative",1:"positive") "RTN","RAHL23Q",279,0) .S RATXT(2)="acknowledgment to NTP's query." D ERR(.RATXT) "RTN","RAHL23Q",280,0) .Q "RTN","RAHL23Q",281,0) ;if RAX=0 then the MSH segment building function failed. "RTN","RAHL23Q",282,0) ; "RTN","RAHL23Q",283,0) ;build the MSA segment "RTN","RAHL23Q",284,0) S RAX=$$MSA^RAHL23Q1($G(RAERR)) "RTN","RAHL23Q",285,0) D:'RAX SEGERR("MSA") "RTN","RAHL23Q",286,0) ; "RTN","RAHL23Q",287,0) ;build the QRD segment "RTN","RAHL23Q",288,0) S RAX=$$BLDQRD^RAHL23Q1() D:'RAX SEGERR("QRD") Q:'RAX "RTN","RAHL23Q",289,0) ; "RTN","RAHL23Q",290,0) ;build the QRF segment "RTN","RAHL23Q",291,0) S RAX=$$BLDQRF^RAHL23Q1() D:'RAX SEGERR("QRF") Q:'RAX "RTN","RAHL23Q",292,0) ; "RTN","RAHL23Q",293,0) ;if the ORF/R04 message is a positive acknowledgement then build the "RTN","RAHL23Q",294,0) ;PID, OBR, & multiple OBX segments. The DSC segment may be created "RTN","RAHL23Q",295,0) ;iff RAQUANT>1 "RTN","RAHL23Q",296,0) I '($D(RAERR)#2) D Q:'RAX "RTN","RAHL23Q",297,0) .S RAX=$$PID^RAHL23Q1() D:'RAX SEGERR("PID") Q:'RAX "RTN","RAHL23Q",298,0) .S RAX=$$OBR^RAHL23Q1() D:'RAX SEGERR("OBR") Q:'RAX "RTN","RAHL23Q",299,0) .S RAX=$$OBXPRC^RAHL23Q1() D:'RAX SEGERR("OBX (Procedure)") Q:'RAX "RTN","RAHL23Q",300,0) .S RAX=$$OBXIMP^RAHL23Q1() D:'RAX SEGERR("OBX (Impression Text)") Q:'RAX "RTN","RAHL23Q",301,0) .S RAX=$$OBXDIA^RAHL23Q1() D:'RAX SEGERR("OBX (Primary Dx. Codes)") Q:'RAX "RTN","RAHL23Q",302,0) .; "RTN","RAHL23Q",303,0) .I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0)) D Q:'RAX "RTN","RAHL23Q",304,0) ..S RAX=$$OBXDIA2^RAHL23Q1() D:'RAX SEGERR("OBX (Secondary Dx. Codes)") Q "RTN","RAHL23Q",305,0) .; "RTN","RAHL23Q",306,0) .S RAX=$$OBXRPT^RAHL23Q1() D:'RAX SEGERR("OBX (Report Text)") Q:'RAX "RTN","RAHL23Q",307,0) .S RAX=$$OBXPMOD^RAHL23Q1() D:'RAX SEGERR("OBX (Procedure Modifiers)") Q:'RAX "RTN","RAHL23Q",308,0) .S RAX=$$OBXCMOD^RAHL23Q1() D:'RAX SEGERR("OBX (CPT Modifiers)") Q:'RAX "RTN","RAHL23Q",309,0) .S RAX=$$OBXTCM^RAHL23Q1() D:'RAX SEGERR("OBX (Tech. Comments)") Q:'RAX "RTN","RAHL23Q",310,0) .I RAQUANT>1 S RAX=$$DSC^RAHL23Q1() D:'RAX SEGERR("DSC") "RTN","RAHL23Q",311,0) .Q "RTN","RAHL23Q",312,0) ;Define sending and receiving application parameters "RTN","RAHL23Q",313,0) S RAPARAM("SENDING APPLICATION")="RA-NTP-QUERY",RAPARAM("QUEUE")="RA-NTP-ORF_R04" "RTN","RAHL23Q",314,0) S RAPARAM("ACCEPT ACK TYPE")="AL",RAPARAM("APP ACK TYPE")="NE" "RTN","RAHL23Q",315,0) S RAPARAM("ACCEPT ACK RESPONSE")="ACCEPT^RAHL23QU" "RTN","RAHL23Q",316,0) ; "RTN","RAHL23Q",317,0) ;name the outbound queue that is responsible for our query replies "RTN","RAHL23Q",318,0) S RAWHO("RECEIVING APPLICATION")="RA-NTP-RSP" "RTN","RAHL23Q",319,0) ; "RTN","RAHL23Q",320,0) ;*** determine the logical link to use P107 *** "RTN","RAHL23Q",321,0) S RAWHO("FACILITY LINK IEN")=$$FIND1^DIC(870,"","M",RAZDNS) "RTN","RAHL23Q",322,0) I RAWHO("FACILITY LINK IEN")'>0 S RATXT(1)="DNS Address lookup failed." D ERR(.RATXT) QUIT "RTN","RAHL23Q",323,0) ; "RTN","RAHL23Q",324,0) ;Send the message "RTN","RAHL23Q",325,0) S RAX=$$SENDONE^HLOAPI1(.HLMSTATE,.RAPARAM,.RAWHO,.RAERROR) "RTN","RAHL23Q",326,0) I $D(RAERROR)#2 D "RTN","RAHL23Q",327,0) .S RATXT(1)="An error was encountered when broadcasting/sending the ORF/R04" "RTN","RAHL23Q",328,0) .S RATXT(2)="HL7 message." D ERR(.RATXT) "RTN","RAHL23Q",329,0) .Q "RTN","RAHL23Q",330,0) Q "RTN","RAHL23Q",331,0) ; "RTN","RAHL23Q",332,0) SEGERR(X) ; build the error dialog used whenever the building of a HL7 "RTN","RAHL23Q",333,0) ;segment fails. "RTN","RAHL23Q",334,0) ;Input: X=the specific segment that failed: MSA, QRD, QRF, PID, OBR, "RTN","RAHL23Q",335,0) ;OBX, or DSC. "RTN","RAHL23Q",336,0) N RATXT S RATXT(1)="An error was encountered when building the ORF/R04 HL7 message." "RTN","RAHL23Q",337,0) S RATXT(2)="HL7 segment: "_X D ERR(.RATXT) "RTN","RAHL23Q",338,0) Q "RTN","RAHL23Q",339,0) ; "RTN","RAHL24Q") 0^2^B17508754^n/a "RTN","RAHL24Q",1,0) RAHL24Q ;HINES OIFO/GJC process & respond to query message ; 22 Apr 2011 09:00 AM "RTN","RAHL24Q",2,0) ;;5.0;Radiology/Nuclear Medicine;**107**;Mar 16, 1998;Build 2 "RTN","RAHL24Q",3,0) ; "RTN","RAHL24Q",4,0) ;ROUTINE IA # USAGE CUSTODIAN "RTN","RAHL24Q",5,0) ; TAG "RTN","RAHL24Q",6,0) ;---------------------------------------------------------- "RTN","RAHL24Q",7,0) ;%ZTLOAD 10063 Supported VA Kernel "RTN","RAHL24Q",8,0) ; %ZTLOAD "RTN","RAHL24Q",9,0) ;DIC 2051 Supported VA FileMan "RTN","RAHL24Q",10,0) ; $$FIND1() "RTN","RAHL24Q",11,0) ;HLOPRS 4718 Supported VistA HL7 "RTN","RAHL24Q",12,0) ; $$STARTMSG() "RTN","RAHL24Q",13,0) ; $$NEXTSEG() "RTN","RAHL24Q",14,0) ; $$GET() "RTN","RAHL24Q",15,0) ;XLFDT 10103 Supported VA Kernel "RTN","RAHL24Q",16,0) ; $$FMADD() "RTN","RAHL24Q",17,0) ; $$HL7TFM() "RTN","RAHL24Q",18,0) ; $$NOW() "RTN","RAHL24Q",19,0) ;XMD 10070 Supported VA MailMan "RTN","RAHL24Q",20,0) ; XMD "RTN","RAHL24Q",21,0) ; "RTN","RAHL24Q",22,0) SRV ;VistA server: receive/process the inbound v2.4 query "RTN","RAHL24Q",23,0) S:$G(U)'="^" U="^" ;under development "RTN","RAHL24Q",24,0) N HL,HLA,HLSTART "RTN","RAHL24Q",25,0) ; "RTN","RAHL24Q",26,0) DISMSH ; disassemble the MSH segment "RTN","RAHL24Q",27,0) I '$$STARTMSG^HLOPRS(.HLMSTATE,HLMSGIEN,.RAMSH) D Q "RTN","RAHL24Q",28,0) .K RATXT S RATXT(1)="$$STARTMSG^HLOPRS failed: Contact the national Rad/Nuc Med" "RTN","RAHL24Q",29,0) .S RATXT(2)="development team." "RTN","RAHL24Q",30,0) .D ERR Q "RTN","RAHL24Q",31,0) ; "RTN","RAHL24Q",32,0) ;RAMSH array elements defined "RTN","RAHL24Q",33,0) ;---------------------------- "RTN","RAHL24Q",34,0) ;RAMSH("SEGMENT TYPE")="MSH" RAMSH("DT/TM OF MESSAGE") "RTN","RAHL24Q",35,0) ;RAMSH("FIELD SEPARATOR") RAMSH("SECURITY") "RTN","RAHL24Q",36,0) ;RAMSH("COMPONENT SEPARATOR") RAMSH("MESSAGE TYPE") "RTN","RAHL24Q",37,0) ;RAMSH("SUBCOMPONENT SEPARATOR") RAMSH("EVENT") "RTN","RAHL24Q",38,0) ;RAMSH("REPETITION SEPARATOR") RAMSH("MESSAGE STRUCTURE") "RTN","RAHL24Q",39,0) ;RAMSH("ESCAPE CHARACTER") RAMSH("MESSAGE CONTROL ID") "RTN","RAHL24Q",40,0) ;RAMSH("SENDING APPLICATION") RAMSH("PROCESSING ID") "RTN","RAHL24Q",41,0) ;RAMSH("SENDING FACILITY",1) 1st component RAMSH("PROCESSING MODE") "RTN","RAHL24Q",42,0) ;RAMSH("SENDING FACILITY",2) 2nd component RAMSH("VERSION") "RTN","RAHL24Q",43,0) ;RAMSH("SENDING FACILITY",3) 3rd component RAMSH("CONTINUATION POINTER") "RTN","RAHL24Q",44,0) ;RAMSH("RECEIVING APPLICATION") RAMSH("ACCEPT ACK TYPE") "RTN","RAHL24Q",45,0) ;RAMSH("RECEIVING FACILITY",1) 1st component RAMSH("APP ACK TYPE") "RTN","RAHL24Q",46,0) ;RAMSH("RECEIVING FACILITY",2) 2nd component RAMSH("COUNTRY") "RTN","RAHL24Q",47,0) ;RAMSH("RECEIVING FACILITY",3) 3rd component "RTN","RAHL24Q",48,0) ; "RTN","RAHL24Q",49,0) S RAMSGCNTID=RAMSH("MESSAGE CONTROL ID") "RTN","RAHL24Q",50,0) ; "RTN","RAHL24Q",51,0) ;Note: The HLO server will use the message type, event type, and version "RTN","RAHL24Q",52,0) ;to look up an entry in the HLO Application Registry. As long as HLO can "RTN","RAHL24Q",53,0) ;find an entry that applies, it will pass the message to the application "RTN","RAHL24Q",54,0) ;and return CA. "RTN","RAHL24Q",55,0) ; "RTN","RAHL24Q",56,0) ;represent encoding characters and the field separator as local variables "RTN","RAHL24Q",57,0) S RAECH=RAMSH("ENCODING CHARACTERS") "RTN","RAHL24Q",58,0) S RAFS=RAMSH("FIELD SEPARATOR") "RTN","RAHL24Q",59,0) S RACS=RAMSH("COMPONENT SEPARATOR") "RTN","RAHL24Q",60,0) S RARS=RAMSH("REPETITION SEPARATOR") "RTN","RAHL24Q",61,0) S RAESC=RAMSH("ESCAPE CHARACTER") "RTN","RAHL24Q",62,0) S RASCS=RAMSH("SUBCOMPONENT SEPARATOR") "RTN","RAHL24Q",63,0) ; "RTN","RAHL24Q",64,0) GETSEG ; disassemble the rest (segments after the MSH) of the query message "RTN","RAHL24Q",65,0) F Q:'$$NEXTSEG^HLOPRS(.HLMSTATE,.RASEG) D "RTN","RAHL24Q",66,0) .;get the fields and set the proper local variables... "RTN","RAHL24Q",67,0) .I $$GET^HLOPRS(.RASEG,RAFS,RACS,RASCS,RARS) "RTN","RAHL24Q",68,0) .;the data is in this format: SEG(FIELD #,REP,COMP,SUBCOMP) "RTN","RAHL24Q",69,0) .D @RASEG(0) "RTN","RAHL24Q",70,0) .Q "RTN","RAHL24Q",71,0) ; "RTN","RAHL24Q",72,0) TASK ;task off the response "RTN","RAHL24Q",73,0) S ZTDESC="RA HL7 2.4 QBP/RSP - return specific radiology results to NTP" "RTN","RAHL24Q",74,0) S (ZTSAVE("RA*"),ZTSAVE("RAMSH("))="" "RTN","RAHL24Q",75,0) ;ZTSAVE("HLMSTATE("))="" "RTN","RAHL24Q",76,0) S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,0,10) "RTN","RAHL24Q",77,0) S ZTIO="",ZTRTN="START^RAHL24U" "RTN","RAHL24Q",78,0) D ^%ZTLOAD "RTN","RAHL24Q",79,0) K ZTDESC,ZTDTH,ZTRTN,ZTSAVE "RTN","RAHL24Q",80,0) ; "RTN","RAHL24Q",81,0) EXIT ;the end... kill variables and exit. "RTN","RAHL24Q",82,0) K HL,HLCS,HLECH,HLFS,HLQ,HLREP,HLSCS,RABEG,RABEGHL7,RACNI,RACNT "RTN","RAHL24Q",83,0) K RACONSTANT,RACS,RADATA,RADFN,RADTE,RADTI,RAECH,RAEND,RAENDHL7 "RTN","RAHL24Q",84,0) K RAERR,RAERROR,RAESC,RAFS,RAMSGCNTID,RAMSGQRYNAME,RAMSGPRIOR "RTN","RAHL24Q",85,0) K RAMSG,RAMSH,RAOIFN,RAPSET,RAQCPT,RAQDAYCS,RAQPIMG,RAQPRC "RTN","RAHL24Q",86,0) K RARPT,RARS,RASCS,RASEG,RAX,RAY2,RAY3 "RTN","RAHL24Q",87,0) Q "RTN","RAHL24Q",88,0) ; "RTN","RAHL24Q",89,0) ;-----------------------------------------------------------------------------\ "RTN","RAHL24Q",90,0) FAILURE ;transmission of the message fails: message not sent, commit to message "RTN","RAHL24Q",91,0) ;is missing. "RTN","RAHL24Q",92,0) K RATXT S RATXT(1)="$$SENDONE^HLOAPI1: message issue ("_$G(HLMSGIEN,-1)_")." "RTN","RAHL24Q",93,0) S RATXT(2)="Contact the national Rad/Nuc Med development team." "RTN","RAHL24Q",94,0) ;fall through... "RTN","RAHL24Q",95,0) ERR ;come here to generate a VistA MailMan email when there is a problem "RTN","RAHL24Q",96,0) ;Input: RATXT=error text (array) as it is displayed to the user "RTN","RAHL24Q",97,0) ; RAMSGCNTID set in SRV^RAHL24Q "RTN","RAHL24Q",98,0) N XMDUN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ "RTN","RAHL24Q",99,0) S XMY(DUZ)="",XMY("G.RAD HL7 MESSAGES")="",XMDUZ=.5 "RTN","RAHL24Q",100,0) S XMSUB="VistA Radiology HL7 query alert error",XMTEXT="RATXT(" "RTN","RAHL24Q",101,0) S RATXT($O(RATXT($C(32)),-1)+1)="Message Control ID: "_$G(RAMSGCNTID,-1) "RTN","RAHL24Q",102,0) D ^XMD K RATXT "RTN","RAHL24Q",103,0) Q "RTN","RAHL24Q",104,0) ; "RTN","RAHL24Q",105,0) QPD ; disassemble the QPD segment "RTN","RAHL24Q",106,0) ;output: see below... "RTN","RAHL24Q",107,0) ; "RTN","RAHL24Q",108,0) ;Field HL7 Field Name VistA local variable assigned its value "RTN","RAHL24Q",109,0) ;----- -------------- --------------------------------------- "RTN","RAHL24Q",110,0) ; 1 Message Query Name RAMSGQRYNAME "RTN","RAHL24Q",111,0) ; 2 Query Tag RAQRYTAG "RTN","RAHL24Q",112,0) ; 3 User Parameters RAMRN (patient identifier) "RTN","RAHL24Q",113,0) ; RABEG("HL7") (begin date/time; HL7 format) "RTN","RAHL24Q",114,0) ; RAEND("HL7") (end date/time; HL7 format) "RTN","RAHL24Q",115,0) S RAMSGQRYNAME=RASEG(1,1,1,1)_RACS_RASEG(1,1,2,1) "RTN","RAHL24Q",116,0) S RAQRYTAG=RASEG(2,1,1,1) "RTN","RAHL24Q",117,0) S RAMRN=RASEG(3,1,3,1) "RTN","RAHL24Q",118,0) S RABEGHL7=RASEG(3,3,3,1),RAENDHL7=RASEG(3,4,3,1) "RTN","RAHL24Q",119,0) ;convert begin & end date/times from HL7 format to internal FileMan format "RTN","RAHL24Q",120,0) S RABEG("FM")=$$HL7TFM^XLFDT(RABEGHL7,"L") "RTN","RAHL24Q",121,0) S RAEND("FM")=$$HL7TFM^XLFDT(RAENDHL7,"L") "RTN","RAHL24Q",122,0) S RADTE=$$FMADD^XLFDT(RABEG("FM"),0,0,0,-1) ;lower limit of our timeframe "RTN","RAHL24Q",123,0) S RADTE=$E(RADTE,1,12) "RTN","RAHL24Q",124,0) S RAEND=((RAEND("FM"))\1)+.2359 ;upper limit of our timeframe "RTN","RAHL24Q",125,0) ;lookup the patient "RTN","RAHL24Q",126,0) S RADFN=$$MRNTDFN(RAMRN) "RTN","RAHL24Q",127,0) K RABEG("FM"),RAEND("FM") "RTN","RAHL24Q",128,0) Q "RTN","RAHL24Q",129,0) ; "RTN","RAHL24Q",130,0) RCP ; disassemble the RCP segment "RTN","RAHL24Q",131,0) ;output: sets RAERR in case of error (checked in GETSEG) "RTN","RAHL24Q",132,0) ; "RTN","RAHL24Q",133,0) ;Field HL7 Field Name VistA local variable assigned its value "RTN","RAHL24Q",134,0) ;----- -------------- --------------------------------------- "RTN","RAHL24Q",135,0) ; 1 Query Priority RAMSGPRIOR (message priority) "RTN","RAHL24Q",136,0) ; 2 Quantity limited RAQUANTITY (max number of records "RTN","RAHL24Q",137,0) ; request to return) "RTN","RAHL24Q",138,0) S RAMSGPRIOR=RASEG(1,1,1,1) "RTN","RAHL24Q",139,0) S RAQUANTITY=RASEG(2,1,1,1) "RTN","RAHL24Q",140,0) Q "RTN","RAHL24Q",141,0) ; "RTN","RAHL24Q",142,0) MRNTDFN(RAMRN) ;This function will convert the patient's MRN, the SSN "RTN","RAHL24Q",143,0) ; with or without hyphens, into their DFN "RTN","RAHL24Q",144,0) ; "RTN","RAHL24Q",145,0) ; input: patient MRN "RTN","RAHL24Q",146,0) ;output: patient DFN if successful, 0 if unsuccessful or null if error "RTN","RAHL24Q",147,0) ; Note: on an error I'll return -1^error text instead of null "RTN","RAHL24Q",148,0) ; "RTN","RAHL24Q",149,0) N DFN S DFN=$$FIND1^DIC(2,,"X",$TR(RAMRN,"-",""),"SSN",,"RAERR") "RTN","RAHL24Q",150,0) S:DFN="" DFN="-1" "RTN","RAHL24Q",151,0) K DIERR,RAERR "RTN","RAHL24Q",152,0) Q DFN "RTN","RAHL24Q",153,0) ; "RTN","RAHL24U") 0^3^B179243251^n/a "RTN","RAHL24U",1,0) RAHL24U ;HINES OIFO/GJC process & respond to query message utilities "RTN","RAHL24U",2,0) ;;5.0;Radiology/Nuclear Medicine;**107**;Mar 16, 1998;Build 2 "RTN","RAHL24U",3,0) ; "RTN","RAHL24U",4,0) ;ROUTINE IA # USAGE CUSTODIAN "RTN","RAHL24U",5,0) ; TAG "RTN","RAHL24U",6,0) ;---------------------------------------------------------- "RTN","RAHL24U",7,0) ;DIC 2051 Supported VA FileMan "RTN","RAHL24U",8,0) ; $$FIND1 "RTN","RAHL24U",9,0) ;DIQ 2056 Supported VA FileMan "RTN","RAHL24U",10,0) ; $$GET1() "RTN","RAHL24U",11,0) ;DIWP 10011 Supported VA FileMan "RTN","RAHL24U",12,0) ; DIWP "RTN","RAHL24U",13,0) ;HLOAPI 4716 Supported VistA HL7 "RTN","RAHL24U",14,0) ; $$MOVESEG() "RTN","RAHL24U",15,0) ; $$NEWMSG() "RTN","RAHL24U",16,0) ;HLOAPI1 4717 Supported VistA HL7 "RTN","RAHL24U",17,0) ; $$SENDONE() "RTN","RAHL24U",18,0) ;MAGDRAHL 5022 Private VistA Imaging "RTN","RAHL24U",19,0) ; $$ZDS^MAGDRAHL() "RTN","RAHL24U",20,0) ;MAG7UFO 4845 Private VistA Imaging "RTN","RAHL24U",21,0) ; NPFON "RTN","RAHL24U",22,0) ;XLFDT 10103 Supported VistA Kernel "RTN","RAHL24U",23,0) ; $$FMADD() "RTN","RAHL24U",24,0) ; $$FMTHL7() "RTN","RAHL24U",25,0) ;XLFNAME 3065 Supported VistA Kernel "RTN","RAHL24U",26,0) ; $$HLNAME() "RTN","RAHL24U",27,0) ; "RTN","RAHL24U",28,0) ;Note about variablies in symbol table: "RTN","RAHL24U",29,0) ; -RAMSG is an array that is dedicated to the response message "RTN","RAHL24U",30,0) ; "RTN","RAHL24U",31,0) START ; get Radiology data (RAD/NUC MED REPORTS #74 file) "RTN","RAHL24U",32,0) S RACONSTANT=9999999.9999,(RACNT,RADATA)=0 "RTN","RAHL24U",33,0) ;RADTE & RAEND passed in (ztsave)... "RTN","RAHL24U",34,0) S (HLECH,HL("ECH"))=RAECH,(HLFS,HL("FS"))=RAFS "RTN","RAHL24U",35,0) S (HLQ,HL("Q"))="""""",HLCS=$E(HL("ECH")) "RTN","RAHL24U",36,0) S HLSCS=$E(HL("ECH"),4),(HLREP,HLRS)=$E(HL("ECH"),2) "RTN","RAHL24U",37,0) ; "RTN","RAHL24U",38,0) ;format: ^RADPT(RADFN,"DT","B",RADTE,RADTI) "RTN","RAHL24U",39,0) ; "RTN","RAHL24U",40,0) F S RADTE=$O(^RADPT(RADFN,"DT","B",RADTE)) Q:'RADTE!(RADTE>RAEND) D Q:RACNT=RAQUANTITY "RTN","RAHL24U",41,0) .S RADTI=(RACONSTANT-RADTE) ;inverse date/time format "RTN","RAHL24U",42,0) .S (RACNI,RAPSET)=0 ;RAPSET = printset flag "RTN","RAHL24U",43,0) .F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:'RACNI D Q:(RACNT=RAQUANTITY)!RAPSET "RTN","RAHL24U",44,0) ..; "RTN","RAHL24U",45,0) ..;1) quit if the study has been cancelled (ORDER field set to zero) "RTN","RAHL24U",46,0) ..S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) ;EXAMINATIONS SUB-FIELD "RTN","RAHL24U",47,0) ..Q:$P($G(^RA(72,$P(RAY3,U,3),0)),U,3)=0 "RTN","RAHL24U",48,0) ..; "RTN","RAHL24U",49,0) ..;2) quit if the study does not have a report "RTN","RAHL24U",50,0) ..Q:$P(RAY3,U,17)="" "RTN","RAHL24U",51,0) ..; "RTN","RAHL24U",52,0) ..;3) quit if that report is not signed (req'd: REPORT STATUS = Verified) "RTN","RAHL24U",53,0) ..S RARPT=$P(RAY3,U,17),RARPT(0)=$G(^RARPT(RARPT,0)) "RTN","RAHL24U",54,0) ..Q:$P(RARPT(0),U,5)'="V" "RTN","RAHL24U",55,0) ..; "RTN","RAHL24U",56,0) ..S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)) ;REGISTERED EXAMS SUB-FIELD "RTN","RAHL24U",57,0) ..S RACN=$P(RAY3,U),RAOIFN=+$P(RAY3,U,11),RAOIFN(0)=$G(^RAO(75.1,RAOIFN,0)) "RTN","RAHL24U",58,0) ..; is the study part of a printset? (pset = multiple studies share the same report) "RTN","RAHL24U",59,0) ..S:$P(RAY3,U,25)=2 RAPSET=1 "RTN","RAHL24U",60,0) ..; "RTN","RAHL24U",61,0) ..;OBX segment order: PROCEDURE, IMPRESSION TEXT, DIAGNOSTIC CODE (primary & secondary) "RTN","RAHL24U",62,0) ..;PROCEDURE MODIFIER, TECH COMMENTS, CPT MODIFIER & REPORT TEXT. "RTN","RAHL24U",63,0) ..K RAERR,RAERROR "RTN","RAHL24U",64,0) ..D INIT "RTN","RAHL24U",65,0) ..;RADATA=1 (RADATA initialized to zero) indicates we've "RTN","RAHL24U",66,0) ..;found at least one patient result to satisfy the query "RTN","RAHL24U",67,0) ..S RADATA=1 "RTN","RAHL24U",68,0) ..D CLIENT Q:$G(RAERR)=0 "RTN","RAHL24U",69,0) ..D BLDMSA Q:$G(RAERR)=0 "RTN","RAHL24U",70,0) ..D BLDQAK Q:$G(RAERR)=0 "RTN","RAHL24U",71,0) ..D BLDQPD Q:$G(RAERR)=0 "RTN","RAHL24U",72,0) ..D BLDRCP Q:$G(RAERR)=0 "RTN","RAHL24U",73,0) ..D BLDPID Q:$G(RAERR)=0 "RTN","RAHL24U",74,0) ..D BLDOBR Q:$G(RAERR)=0 "RTN","RAHL24U",75,0) ..D BLDZDS Q:$G(RAERR)=0 "RTN","RAHL24U",76,0) ..D BLDPROC Q:$G(RAERR)=0 "RTN","RAHL24U",77,0) ..D BLDTEXT("I") Q:$G(RAERR)=0 "RTN","RAHL24U",78,0) ..D BLDMISC("DX") Q:$G(RAERR)=0 "RTN","RAHL24U",79,0) ..D BLDMISC("M") Q:$G(RAERR)=0 "RTN","RAHL24U",80,0) ..D BLDTCOM Q:$G(RAERR)=0 "RTN","RAHL24U",81,0) ..D BLDMISC("CMOD") Q:$G(RAERR)=0 "RTN","RAHL24U",82,0) ..D BLDTEXT("R") Q:$G(RAERR)=0 "RTN","RAHL24U",83,0) ..D BROADCST "RTN","RAHL24U",84,0) ..Q "RTN","RAHL24U",85,0) .Q "RTN","RAHL24U",86,0) I $G(RADATA)'=1 D "RTN","RAHL24U",87,0) .D CLIENT Q:$G(RAERR)=0 "RTN","RAHL24U",88,0) .D BLDMSA Q:$G(RAERR)=0 "RTN","RAHL24U",89,0) .D BLDERR Q:$G(RAERR)=0 "RTN","RAHL24U",90,0) .D BLDQAK Q:$G(RAERR)=0 "RTN","RAHL24U",91,0) .D BLDQPD Q:$G(RAERR)=0 "RTN","RAHL24U",92,0) .D BLDRCP Q:$G(RAERR)=0 "RTN","RAHL24U",93,0) .D BROADCST "RTN","RAHL24U",94,0) .K RATXT "RTN","RAHL24U",95,0) .S RATXT(1)="no data found for this patient over this timeframe." "RTN","RAHL24U",96,0) .D ERR^RAHL24Q "RTN","RAHL24U",97,0) .QUIT "RTN","RAHL24U",98,0) S:$D(ZTQUEUED) ZTREQ="@" "RTN","RAHL24U",99,0) D EXIT^RAHL24Q "RTN","RAHL24U",100,0) Q "RTN","RAHL24U",101,0) ; "RTN","RAHL24U",102,0) INIT ;initialize radiology variables "RTN","RAHL24U",103,0) ;--- if the site specific accession number exists use it, else build the legacy --- "RTN","RAHL24U",104,0) S RAQDAYCS=$S($P(RAY3,U,31)]"":$P(RAY3,U,31),1:$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_+RAY3) "RTN","RAHL24U",105,0) ;--- "RTN","RAHL24U",106,0) ;RAQPRC: pointer to RAD/NUC MED PROCEDURES file "RTN","RAHL24U",107,0) ;RAQPRC(0): zero node rad/nuc med procedure record "RTN","RAHL24U",108,0) ;RAQIMG: pointer to file IMAGING TYPE file "RTN","RAHL24U",109,0) ;RAQIMG(0): zero node imaging type record "RTN","RAHL24U",110,0) ; "RTN","RAHL24U",111,0) S RAQPRC=+$P(RAY3,U,2),RAQPRC(0)=$G(^RAMIS(71,RAQPRC,0)) "RTN","RAHL24U",112,0) S RAQPIMG=+$P($G(^RAMIS(71,RAQPRC,0)),U,12) "RTN","RAHL24U",113,0) S RAQPIMG(0)=$G(^RA(79.2,RAQPIMG,0)) "RTN","RAHL24U",114,0) S RAQCPT=+$P(RAQPRC(0),U,9),RAQCPT(0)=$$NAMCODE^RACPTMSC(RAQCPT,DT) "RTN","RAHL24U",115,0) Q "RTN","RAHL24U",116,0) ; "RTN","RAHL24U",117,0) CLIENT ; VistA client: build/broadcast the response to the query "RTN","RAHL24U",118,0) K RAERR,RAERROR,RAPARAM S RAPARAM("COUNTRY")="USA",RAPARAM("FIELD SEPARATOR")=HLFS "RTN","RAHL24U",119,0) S RAPARAM("ENCODING CHARACTERS")=HLECH,RAPARAM("VERSION")=2.4 "RTN","RAHL24U",120,0) S RAPARAM("MESSAGE TYPE")="RSP",RAPARAM("EVENT")="K11" "RTN","RAHL24U",121,0) S RAPARAM("MESSAGE STRUCTURE")="RSP_K11",RAPARAM("PROCESSING MODE")="P" "RTN","RAHL24U",122,0) ;Create the new message (builds the MSH segment) "RTN","RAHL24U",123,0) S RAERR=$$NEWMSG^HLOAPI(.RAPARAM,.RAMSG,.RAERROR) ;Note RAERR=0 if call failed "RTN","RAHL24U",124,0) I RAERR=0 D "RTN","RAHL24U",125,0) .S RATXT(1)="$$NEWMSG^HLOAPI1 failed: Contact the national Rad/Nuc Med" "RTN","RAHL24U",126,0) .S RATXT(2)="development team." "RTN","RAHL24U",127,0) .D ERR^RAHL24Q "RTN","RAHL24U",128,0) .QUIT "RTN","RAHL24U",129,0) K RAERROR,RAPARAM "RTN","RAHL24U",130,0) QUIT "RTN","RAHL24U",131,0) ; "RTN","RAHL24U",132,0) BLDMSA ; build the MSA segment "RTN","RAHL24U",133,0) K RAERR N SEG S SEG="" "RTN","RAHL24U",134,0) S SEG(1)="MSA"_HLFS_$S(RADATA=0:"AE",1:"AA")_HLFS_RAMSGCNTID "RTN","RAHL24U",135,0) S RAERR=$$MOVESEG^HLOAPI(.RAMSG,.SEG,.RAERROR) ;Note RAERR=0 if call failed "RTN","RAHL24U",136,0) QUIT "RTN","RAHL24U",137,0) ; "RTN","RAHL24U",138,0) BLDERR ; build ERR segment "RTN","RAHL24U",139,0) K RAERR N SEG,X S SEG="" "RTN","RAHL24U",140,0) S X="no data for this patient within this timeframe" "RTN","RAHL24U",141,0) S SEG(1)="ERR"_HLFS_"QPD"_HLCS_HLCS_HLCS_HLSCS_X "RTN","RAHL24U",142,0) S RAERR=$$MOVESEG^HLOAPI(.RAMSG,.SEG,.RAERROR) ;Note RAERR=0 if call failed "RTN","RAHL24U",143,0) QUIT "RTN","RAHL24U",144,0) ; "RTN","RAHL24U",145,0) BLDQAK ; build the QAK segment "RTN","RAHL24U",146,0) K RAERR N SEG S SEG="" "RTN","RAHL24U",147,0) S SEG(1)="QAK"_HLFS_RAQRYTAG_HLFS_$S(RADATA=0:"NF",1:"OK")_HLFS_RAMSGQRYNAME "RTN","RAHL24U",148,0) S RAERR=$$MOVESEG^HLOAPI(.RAMSG,.SEG,.RAERROR) ;Note RAERR=0 if call failed "RTN","RAHL24U",149,0) QUIT "RTN","RAHL24U",150,0) ; "RTN","RAHL24U",151,0) BLDQPD ; build the QPD segment "RTN","RAHL24U",152,0) K RAERR N SEG,X S SEG="" "RTN","RAHL24U",153,0) S X="@PID.3.1.1"_HLCS_"EQ"_HLCS_RAMRN_HLCS_"AND"_HLRS_"@PID.3.5.1"_HLCS_"EQ"_HLCS_"SS"_HLCS "RTN","RAHL24U",154,0) S X=X_"AND"_HLRS_"@OBR.22"_HLCS_"GE"_HLCS_RABEGHL7_HLCS_"AND"_HLRS_"@OBR.22" "RTN","RAHL24U",155,0) S X=X_HLCS_"LE"_HLCS_RAENDHL7 "RTN","RAHL24U",156,0) S SEG(1)="QPD"_HLFS_RAMSGQRYNAME_HLFS_RAQRYTAG_HLFS_X "RTN","RAHL24U",157,0) S RAERR=$$MOVESEG^HLOAPI(.RAMSG,.SEG,.RAERROR) ;Note RAERR=0 if call failed "RTN","RAHL24U",158,0) QUIT "RTN","RAHL24U",159,0) ; "RTN","RAHL24U",160,0) BLDRCP ; build the RPC segment "RTN","RAHL24U",161,0) K RAERR N SEG S SEG="" "RTN","RAHL24U",162,0) S SEG(1)="RCP"_HLFS_RAMSGQRYNAME_HLFS_RAQUANTITY "RTN","RAHL24U",163,0) S RAERR=$$MOVESEG^HLOAPI(.RAMSG,.SEG,.RAERROR) ;Note RAERR=0 if call failed "RTN","RAHL24U",164,0) QUIT "RTN","RAHL24U",165,0) ; "RTN","RAHL24U",166,0) BLDPID ; build the PID segment "RTN","RAHL24U",167,0) N HLA,RAPID,SEG "RTN","RAHL24U",168,0) D PID^RAHLRU1(RADFN) ;sets the HLA("HLS" & RAPID arrays "RTN","RAHL24U",169,0) D HLA2SEG "RTN","RAHL24U",170,0) S RAERR=$$MOVESEG^HLOAPI(.RAMSG,.SEG,.RAERROR) ;Note RAERR=0 if call failed "RTN","RAHL24U",171,0) QUIT "RTN","RAHL24U",172,0) ; "RTN","RAHL24U",173,0) BLDOBR ; build the OBR segment "RTN","RAHL24U",174,0) N HLA,RAOBR,RAQPMOD,RAQTRANS,SEG "RTN","RAHL24U",175,0) ;get transcriptionist data (if it exists) "RTN","RAHL24U",176,0) S RAQTRANS=+$G(^RARPT(RARPT,"T")) "RTN","RAHL24U",177,0) ;Set ID OBR-1 "RTN","RAHL24U",178,0) S RAOBR(2)=1 "RTN","RAHL24U",179,0) ;Placer Order Number OBR-2 mmddyy-case# -or- SSAN "RTN","RAHL24U",180,0) ;Filler Order Number OBR-3 mmddyy-case# -or- SSAN "RTN","RAHL24U",181,0) S (RAOBR(3),RAOBR(4))=RAQDAYCS "RTN","RAHL24U",182,0) S RAOBR(5)=$P(RAQCPT(0),U)_$E(HLECH)_$$ESCAPE^RAHLRU($P(RAQCPT(0),U,2))_$E(HLECH)_"C4" "RTN","RAHL24U",183,0) S RAOBR(5)=RAOBR(5)_$E(HLECH)_RAQPRC_$E(HLECH)_$$ESCAPE^RAHLRU($P(RAQPRC,U))_$E(HLECH)_"99RAP" "RTN","RAHL24U",184,0) ;Observation date/time OBR-7 (DATE REPORT ENTERED) 74;6 "RTN","RAHL24U",185,0) S RAOBR(8)=$$FMTHL7^XLFDT($P(RARPT(0),U,6)) "RTN","RAHL24U",186,0) ;Specimen Source OBR-15 75.1;125 PROCEDURE MODIFIERS (mult: 75.1125) "RTN","RAHL24U",187,0) ;(left & right only) "RTN","RAHL24U",188,0) S RAQPMOD=$$SPECSRC^RAHLRU1(+$P(RAY3,U,11)) "RTN","RAHL24U",189,0) S:$L(RAQPMOD) RAOBR(16)=$$REPEAT^RAHLRU1($E(HLECH),4)_$E(HLECH,4)_RAQPMOD "RTN","RAHL24U",190,0) ; "RTN","RAHL24U",191,0) ;Ordering Provider OBR-16 (REQUESTING PHYSICIAN) 75.1;14 "RTN","RAHL24U",192,0) I $P(RAOIFN(0),U,14),($$GET1^DIQ(200,$P(RAOIFN(0),U,14),.01)'="") D "RTN","RAHL24U",193,0) .N RAQNME S RAQNME("FILE")=200,RAQNME("IENS")=$P(RAOIFN(0),U,14) "RTN","RAHL24U",194,0) .S RAQNME("FIELD")=.01 "RTN","RAHL24U",195,0) .S RAOBR(17)=$P(RAOIFN(0),U,14)_$E(HLECH)_$$HLNAME^XLFNAME(.RAQNME,"S",$E(HLECH)) "RTN","RAHL24U",196,0) .Q "RTN","RAHL24U",197,0) ; "RTN","RAHL24U",198,0) ;Call Back Phone numbers of Ordering Provider OBR-17 "RTN","RAHL24U",199,0) D "RTN","RAHL24U",200,0) .N RAI,RAM,RAX S RAM="",RAI=0 "RTN","RAHL24U",201,0) .D NPFON^MAG7UFO("RAX",$P(RAOIFN(0),U,14)) "RTN","RAHL24U",202,0) .F S RAI=$O(RAX(RAI)) Q:'RAI S RAM=RAM_$$ESCAPE^RAHLRU($G(RAX(RAI,1,1)))_$E(HLECH)_$G(RAX(RAI,2,1))_$E(HLECH)_$G(RAX(RAI,3,1))_$E(HLECH,2) "RTN","RAHL24U",203,0) .S:$L(RAM) RAOBR(18)=$E(RAM,1,$L(RAM)-1) "RTN","RAHL24U",204,0) .QUIT "RTN","RAHL24U",205,0) ; "RTN","RAHL24U",206,0) ;Placer Field 1 OBR-18 accession number: may be legacy or SSAN "RTN","RAHL24U",207,0) ;(mirrors OBR-2, OBR-3 & OBR-20) "RTN","RAHL24U",208,0) S RAOBR(19)=RAQDAYCS "RTN","RAHL24U",209,0) ; "RTN","RAHL24U",210,0) ;Placer Field two OBR-19 case number 70.03;.01 "RTN","RAHL24U",211,0) S RAOBR(20)=RACN "RTN","RAHL24U",212,0) ; "RTN","RAHL24U",213,0) ;Filler Field 1 OBR-20 accession number: may be legacy or SSAN "RTN","RAHL24U",214,0) ;(mirrors OBR-2, OBR-3 & OBR-18) "RTN","RAHL24U",215,0) S RAOBR(21)=RAQDAYCS "RTN","RAHL24U",216,0) ; "RTN","RAHL24U",217,0) ;Filler Field 2 OBR-21 "RTN","RAHL24U",218,0) ;Components as separated by the accent grave "`" "RTN","RAHL24U",219,0) ;Subcomponents by the underscore "_" "RTN","RAHL24U",220,0) ;Example: RAD_GENERAL RADIOLOGY`1_TD-RAD`660_SALT LAKE CITY "RTN","RAHL24U",221,0) S RAOBR(22)=$$OBR21^RAHLRU(HLECH,RAY2) "RTN","RAHL24U",222,0) ; "RTN","RAHL24U",223,0) ;Results Rpt/Status Chng-date/time OBR-22 "RTN","RAHL24U",224,0) ;verified: pass VERIFIED DATE 74;7 "RTN","RAHL24U",225,0) S RAOBR(23)=$$FMTHL7^XLFDT($P(RARPT(0),U,7)) "RTN","RAHL24U",226,0) ; "RTN","RAHL24U",227,0) ;Status OBR-25 REPORT STATUS 74;5 "RTN","RAHL24U",228,0) ;Note: treat electronically filed "EF" reports the same as verified "V" reports "RTN","RAHL24U",229,0) S RAOBR(26)=$S(($P(RARPT(0),U,5)="V")!($P(RARPT(0),U,5)="EF"):"F",1:"R") "RTN","RAHL24U",230,0) ; "RTN","RAHL24U",231,0) ;Parent OBR-29 70.03;25 if exam/printset find ordered parent procedure "RTN","RAHL24U",232,0) S:$P(RAY3,U,25) RAOBR(30)=$S($P(RAY3,U,25)=1:"Examset: ",1:"Printset: ")_$P(RAQPRC(0),U) "RTN","RAHL24U",233,0) ; "RTN","RAHL24U",234,0) ;Principal Result Interpreter OBR-32 70.03;15 "RTN","RAHL24U",235,0) I $P(RAY3,U,15),($$GET1^DIQ(200,$P(RAY3,U,15),.01)'="") D "RTN","RAHL24U",236,0) .N RAQNME S RAQNME("FILE")=200,RAQNME("IENS")=$P(RAY3,U,15) "RTN","RAHL24U",237,0) .S RAQNME("FIELD")=.01 "RTN","RAHL24U",238,0) .S RAOBR(33)=$P(RAY3,U,15)_$E(HLECH)_$$HLNAME^XLFNAME(.RAQNME,"S",$E(HLECH)) "RTN","RAHL24U",239,0) .Q "RTN","RAHL24U",240,0) ; "RTN","RAHL24U",241,0) ;Assistant Result Interpreter(s)/contributors OBR-33 70.03;12 "RTN","RAHL24U",242,0) N RACNT,RAI,RAJ S RACNT=0 ; in this instance RACNT is local to BLDOBR "RTN","RAHL24U",243,0) I $P(RAY3,U,12),($$GET1^DIQ(200,$P(RAY3,U,12),.01)'="") D "RTN","RAHL24U",244,0) .K RAQNME S RAQNME("FILE")=200,RAQNME("IENS")=$P(RAY3,U,12) "RTN","RAHL24U",245,0) .S RAQNME("FIELD")=.01,RACNT=RACNT+1 "RTN","RAHL24U",246,0) .S RAOBR(34,RACNT)=$P(RAY3,U,12)_$E(HLECH)_$$HLNAME^XLFNAME(.RAQNME,"S",$E(HLECH)) "RTN","RAHL24U",247,0) .Q "RTN","RAHL24U",248,0) K RAQNME F RAI="SRR","SSR" D Q:RACNT=10 ;cardinality: 10 "RTN","RAHL24U",249,0) .S RAJ=0 "RTN","RAHL24U",250,0) .F S RAJ=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,RAI,RAJ)) Q:'RAJ D Q:RACNT=10 "RTN","RAHL24U",251,0) ..S RAJ(0)=+$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,RAI,RAJ,0)) Q:'RAJ(0) "RTN","RAHL24U",252,0) ..S RAQNME("FILE")=200,RAQNME("IENS")=RAJ(0),RAQNME("FIELD")=.01 "RTN","RAHL24U",253,0) ..S RACNT=RACNT+1 "RTN","RAHL24U",254,0) ..S RAOBR(34,RACNT)=RAJ(0)_$E(HLECH)_$$HLNAME^XLFNAME(.RAQNME,"S",$E(HLECH)) "RTN","RAHL24U",255,0) ..K RAQNME "RTN","RAHL24U",256,0) ..Q "RTN","RAHL24U",257,0) .Q "RTN","RAHL24U",258,0) ; "RTN","RAHL24U",259,0) ;Transcriptionist OBR-35 74;11 "RTN","RAHL24U",260,0) I RAQTRANS,($$GET1^DIQ(200,RAQTRANS,.01)'="") D "RTN","RAHL24U",261,0) .S RAQNME("FILE")=200,RAQNME("IENS")=RAQTRANS,RAQNME("FIELD")=.01 "RTN","RAHL24U",262,0) .S RAOBR(36)=RAQTRANS_$E(HLECH)_$$HLNAME^XLFNAME(.RAQNME,"S",$E(HLECH)) K RAQNME "RTN","RAHL24U",263,0) .Q "RTN","RAHL24U",264,0) ; "RTN","RAHL24U",265,0) ;build the OBR segment "RTN","RAHL24U",266,0) D BLSEG^RAHLRU1("OBR",.RAOBR),HLA2SEG "RTN","RAHL24U",267,0) ; "RTN","RAHL24U",268,0) S RAERR=$$MOVESEG^HLOAPI(.RAMSG,.SEG,.RAERROR) ;Note RAERR=0 if call failed "RTN","RAHL24U",269,0) ;set RAINC to the last established Set ID value "RTN","RAHL24U",270,0) S RAINC=$G(RAOBX(2)) "RTN","RAHL24U",271,0) QUIT "RTN","RAHL24U",272,0) ; "RTN","RAHL24U",273,0) BLDZDS ; build the ZDS segment ^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SIUID") "RTN","RAHL24U",274,0) K RAERR N RASIUID,SEG "RTN","RAHL24U",275,0) S RASIUID=$$GETSIUID^RAAPI(RADFN,RADTI,RACNI) "RTN","RAHL24U",276,0) ;if RASIUID does not exist create it... "RTN","RAHL24U",277,0) S:RASIUID="" RASIUID=$$STUDYUID^MAGDRAHL(RADTI,RACNI,RAQDAYCS) "RTN","RAHL24U",278,0) S SEG="",SEG(1)=$$ZDS^MAGDRAHL(RASIUID) "RTN","RAHL24U",279,0) S RAERR=$$MOVESEG^HLOAPI(.RAMSG,.SEG,.RAERROR) ;Note RAERR=0 if call failed "RTN","RAHL24U",280,0) QUIT "RTN","RAHL24U",281,0) ; "RTN","RAHL24U",282,0) BLDMISC(RASUB) ;get data from secondary DX, CPT Modifiers & Modifiers sub-files. "RTN","RAHL24U",283,0) ; This function builds OBX segments. The OBX segment(s) is(are) defined by the "RTN","RAHL24U",284,0) ; RAOBX array. "RTN","RAHL24U",285,0) ; "RTN","RAHL24U",286,0) ; input: RASUB - "CMOD" = CPT MODIFERS; "DX" = DIAGNOSTIC CODE; "M" = MODIFIERS "RTN","RAHL24U",287,0) ; "RTN","RAHL24U",288,0) ; Note: DT, HLECH, RADFN, RADTI, RACNI, RAINC, RARPT & RAY3 are assumed to exist "RTN","RAHL24U",289,0) ; "RTN","RAHL24U",290,0) ;return: Diagnostic Code/CPT Modifiers/Modifiers OBX segments "RTN","RAHL24U",291,0) ; "RTN","RAHL24U",292,0) ;if we're after Dx Code data check for Primary Dx Code data "RTN","RAHL24U",293,0) ;no primary Dx Code data, no Dx code data period "RTN","RAHL24U",294,0) K RAERR N HLA,SEG "RTN","RAHL24U",295,0) I RASUB="DX",($P(RAY3,U,13)="") Q ; no Dx data... "RTN","RAHL24U",296,0) ;setup the necessary generic variables "RTN","RAHL24U",297,0) N RAIEN,RAOBX,RAQ,RAX S RAQ=0 "RTN","RAHL24U",298,0) S RAOBX(3)=$S(RASUB="M":"TX",1:"CE") "RTN","RAHL24U",299,0) S:RASUB="CMOD" RAOBX(4)="C4"_$E(HLECH)_"CPT MODIFIERS"_$E(HLECH)_"L" "RTN","RAHL24U",300,0) S:RASUB="DX" RAOBX(4)="D"_$E(HLECH)_"DIAGNOSTIC CODE"_$E(HLECH)_"L" "RTN","RAHL24U",301,0) S:RASUB="M" RAOBX(4)="M"_$E(HLECH)_"MODIFIERS"_$E(HLECH)_"L" "RTN","RAHL24U",302,0) S RAOBX(12)=$$OBX11^RAHLRPT2(RARPT) "RTN","RAHL24U",303,0) ;are we after Dx Codes? if so get those codes "RTN","RAHL24U",304,0) I RASUB="DX",($P(RAY3,U,13)) D "RTN","RAHL24U",305,0) .;--- begin primary Dx code --- "RTN","RAHL24U",306,0) .S RAQ=RAQ+1,RAOBX(2)=RAINC+RAQ "RTN","RAHL24U",307,0) .S RAX=$$ESCAPE^RAHLRU($P($G(^RA(78.3,$P(RAY3,U,13),0)),U)) "RTN","RAHL24U",308,0) .S RAOBX(6)=$P(RAY3,U,13)_$E(HLECH)_RAX_$E(HLECH)_"L" "RTN","RAHL24U",309,0) .D BLSEG^RAHLRU1("OBX",.RAOBX) S RAINC=RAOBX(2) "RTN","RAHL24U",310,0) .D HLA2SEG K HLA "RTN","RAHL24U",311,0) .S RAERR=$$MOVESEG^HLOAPI(.RAMSG,.SEG,.RAERROR) "RTN","RAHL24U",312,0) .Q "RTN","RAHL24U",313,0) ;--- end primary Dx code --- "RTN","RAHL24U",314,0) N RAIEN,RAQ,RAY,X,Y S (RAQ,RAY)=0 "RTN","RAHL24U",315,0) S RAX=$NA(^RADPT(RADFN,"DT",RADTI,"P",RACNI,RASUB)) "RTN","RAHL24U",316,0) F S RAY=$O(@RAX@(RAY)) Q:'RAY D "RTN","RAHL24U",317,0) .S RAIEN=+$G(@RAX@(RAY,0)) Q:'RAIEN "RTN","RAHL24U",318,0) .;RAIEN is an Internal Entry Number which needs to get resolved. "RTN","RAHL24U",319,0) .S RAQ=RAQ+1,RAOBX(2)=RAINC+RAQ ;increment Set ID "RTN","RAHL24U",320,0) .;note: The value returned by $$CPTMOD^RAHLRU is escaped. "RTN","RAHL24U",321,0) .S:RASUB="CMOD" RAOBX(6)=$$CPTMOD^RAHLRU(RAIEN,HLECH,DT) "RTN","RAHL24U",322,0) .;escape it... "RTN","RAHL24U",323,0) .S:RASUB="DX" RAOBX(6)=RAIEN_$E(HLECH)_$$ESCAPE^RAHLRU($P($G(^RA(78.3,RAIEN,0)),U))_$E(HLECH)_"L" "RTN","RAHL24U",324,0) .S:RASUB="M" RAOBX(6)=$$ESCAPE^RAHLRU($P($G(^RAMIS(71.2,RAIEN,0)),U)) "RTN","RAHL24U",325,0) .D BLSEG^RAHLRU1("OBX",.RAOBX) "RTN","RAHL24U",326,0) .D HLA2SEG K HLA "RTN","RAHL24U",327,0) .S RAERR=$$MOVESEG^HLOAPI(.RAMSG,.SEG,.RAERROR) "RTN","RAHL24U",328,0) .Q "RTN","RAHL24U",329,0) S RAINC=$G(RAOBX(2)) "RTN","RAHL24U",330,0) QUIT "RTN","RAHL24U",331,0) ; "RTN","RAHL24U",332,0) BLDTEXT(RASUB) ;get IMPRESSION TEXT & REPORT TEXT. "RTN","RAHL24U",333,0) ; This function builds OBX segments. The OBX segment(s) is(are) defined by "RTN","RAHL24U",334,0) ; the RAOBX array. "RTN","RAHL24U",335,0) ; "RTN","RAHL24U",336,0) ; input: RASUB - "I" = IMPRESSION TEXT; "R" = REPORT TEXT "RTN","RAHL24U",337,0) ; "RTN","RAHL24U",338,0) ; Note: DT, HLECH, RAINC & RARPT are assumed to exist "RTN","RAHL24U",339,0) ; "RTN","RAHL24U",340,0) ;return: Impression Text or Report Text OBX segment "RTN","RAHL24U",341,0) ; "RTN","RAHL24U",342,0) K RAERR N HLA,RAOBX,RAQ,RAX,RAXRX,RAY,SEG "RTN","RAHL24U",343,0) S RAX=$NA(^RARPT(RARPT,RASUB)) "RTN","RAHL24U",344,0) Q:'$O(@RAX@(0)) ;no impression/report text to return "RTN","RAHL24U",345,0) S (RAQ,RAY)=0 "RTN","RAHL24U",346,0) ;format text using existing FM utilities "RTN","RAHL24U",347,0) F S RAY=$O(@RAX@(RAY)) Q:'RAY D "RTN","RAHL24U",348,0) .S RAXRX=$G(@RAX@(RAY,0)) "RTN","RAHL24U",349,0) .S RAOBX(3)="TX" "RTN","RAHL24U",350,0) .S RAOBX(4)=RASUB_$E(HLECH)_$S(RASUB="I":"IMPRESSION",1:"REPORT")_$E(HLECH)_"L" "RTN","RAHL24U",351,0) .S RAOBX(12)=$$OBX11^RAHLRPT2(RARPT) "RTN","RAHL24U",352,0) .S RAQ=RAQ+1,RAOBX(2)=RAINC+RAQ ;increment Set ID "RTN","RAHL24U",353,0) .S RAOBX(6)=$$ESCAPE^RAHLRU(RAXRX) "RTN","RAHL24U",354,0) .D BLSEG^RAHLRU1("OBX",.RAOBX) "RTN","RAHL24U",355,0) .D HLA2SEG K HLA "RTN","RAHL24U",356,0) .S RAERR=$$MOVESEG^HLOAPI(.RAMSG,.SEG,.RAERROR) "RTN","RAHL24U",357,0) .Q "RTN","RAHL24U",358,0) ; "RTN","RAHL24U",359,0) S RAINC=$G(RAOBX(2)) "RTN","RAHL24U",360,0) QUIT "RTN","RAHL24U",361,0) ; "RTN","RAHL24U",362,0) BLDPROC ;get exam procedure; build the OBX segment dedicated to that procedure "RTN","RAHL24U",363,0) ; "RTN","RAHL24U",364,0) ; input: none "RTN","RAHL24U",365,0) ; "RTN","RAHL24U",366,0) ; Note: HLECH, RAQPRC, RAQPRC(0), RARPT & RAY3 are assumed to exist "RTN","RAHL24U",367,0) ; "RTN","RAHL24U",368,0) ;return: Rad/Nuc Med Procedure OBX segment "RTN","RAHL24U",369,0) ; "RTN","RAHL24U",370,0) N HLA,RAOBX,RAX,SEG "RTN","RAHL24U",371,0) S (RAOBX(2),RAINC)=1 ;RAINC = Set ID value (dynamic) "RTN","RAHL24U",372,0) S RAOBX(3)="CE",RAOBX(4)="P"_$E(HLECH)_"PROCEDURE"_$E(HLECH)_"L" "RTN","RAHL24U",373,0) ;escape the procedure name (.01 field) "RTN","RAHL24U",374,0) S RAX=$$ESCAPE^RAHLRU($P(RAQPRC(0),U)) "RTN","RAHL24U",375,0) S RAOBX(6)=RAQPRC_$E(HLECH)_RAX_$E(HLECH)_"L" "RTN","RAHL24U",376,0) S RAOBX(12)=$$OBX11^RAHLRPT2(RARPT) "RTN","RAHL24U",377,0) D BLSEG^RAHLRU1("OBX",.RAOBX) "RTN","RAHL24U",378,0) D HLA2SEG "RTN","RAHL24U",379,0) S RAERR=$$MOVESEG^HLOAPI(.RAMSG,.SEG,.RAERROR) ;Note RAERR=0 if call failed "RTN","RAHL24U",380,0) S RAINC=$G(RAOBX(2)) "RTN","RAHL24U",381,0) QUIT "RTN","RAHL24U",382,0) ; "RTN","RAHL24U",383,0) BLDTCOM ;get tech comments; build the OBX segment dedicated to those tech comments "RTN","RAHL24U",384,0) ; "RTN","RAHL24U",385,0) ; input: none "RTN","RAHL24U",386,0) ; "RTN","RAHL24U",387,0) ; Note: HLECH, RADFN, RADTI, RACNI & RARPT are assumed to exist "RTN","RAHL24U",388,0) ; "RTN","RAHL24U",389,0) ;return: Tech Comments OBX segment "RTN","RAHL24U",390,0) ; "RTN","RAHL24U",391,0) K RAERR N HLA,RAOBX,RAQ,RAX,RAY,SEG "RTN","RAHL24U",392,0) S RAOBX(3)="TX",RAOBX(4)="TCM"_$E(HLECH)_"TECH COMMENT"_$E(HLECH)_"L" "RTN","RAHL24U",393,0) S RAOBX(12)=$$OBX11^RAHLRPT2(RARPT) "RTN","RAHL24U",394,0) ;escape the procedure name "RTN","RAHL24U",395,0) S (RAQ,RAY)=0 "RTN","RAHL24U",396,0) F S RAY=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"L",RAY)) Q:'RAY D "RTN","RAHL24U",397,0) .S RAX=$$ESCAPE^RAHLRU($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"L",RAY,"TCOM"))) "RTN","RAHL24U",398,0) .S RAQ=RAQ+1,RAOBX(2)=RAINC+RAQ,RAOBX(6)=RAX "RTN","RAHL24U",399,0) .D BLSEG^RAHLRU1("OBX",.RAOBX) "RTN","RAHL24U",400,0) .D HLA2SEG K HLA "RTN","RAHL24U",401,0) .S RAERR=$$MOVESEG^HLOAPI(.RAMSG,.SEG,.RAERROR) ;Note RAERR=0 if call failed "RTN","RAHL24U",402,0) .Q "RTN","RAHL24U",403,0) S RAINC=$G(RAOBX(2)) "RTN","RAHL24U",404,0) QUIT "RTN","RAHL24U",405,0) ; "RTN","RAHL24U",406,0) BROADCST ; broadcast the response(s) to the query "RTN","RAHL24U",407,0) ;if calling SENDONE^HLOAPI1... "RTN","RAHL24U",408,0) ;RAPARAM was set when the $$NEWMSG function was called in client but this will "RTN","RAHL24U",409,0) ;not be an issue here. "RTN","RAHL24U",410,0) N RAPARAM,RAWHO "RTN","RAHL24U",411,0) S RAPARAM("ACCEPT ACK TYPE")="AL",RAPARAM("APP ACK TYPE")="NE" "RTN","RAHL24U",412,0) S RAPARAM("FAILURE RESPONSE")="FAILURE^RAHL24Q" "RTN","RAHL24U",413,0) S RAPARAM("QUEUE")="RA-NTP-QRY-CLIENT" "RTN","RAHL24U",414,0) S RAPARAM("SENDING APPLICATION")="RA-NTP-QRY-SERVER" "RTN","RAHL24U",415,0) S RAWHO("RECEIVING APPLICATION")="RA-NTP-QRY-CLIENT" "RTN","RAHL24U",416,0) ;DNS is passed as the third component in the SENDING FACILTY field "RTN","RAHL24U",417,0) ;of the original (query) message. The second component is the DNS "RTN","RAHL24U",418,0) ;Address. Now find the logical link name for this DNS Address. "RTN","RAHL24U",419,0) S RAWHO("FACILITY LINK IEN")=$$FIND1^DIC(870,"","M",RAMSH("SENDING FACILITY",2)) "RTN","RAHL24U",420,0) I RAWHO("FACILITY LINK IEN")'>0 S RATXT(1)="DNS Address lookup failed." D ERR^RAHL24Q QUIT "RTN","RAHL24U",421,0) I '$$SENDONE^HLOAPI1(.RAMSG,.RAPARAM,.RAWHO,.RAERROR) D "RTN","RAHL24U",422,0) .S RATXT(1)="$$SENDONE^HLOAPI1 failed: Contact the national Rad/Nuc Med" "RTN","RAHL24U",423,0) .S RATXT(2)="development team." "RTN","RAHL24U",424,0) .D ERR^RAHL24Q "RTN","RAHL24U",425,0) .QUIT "RTN","RAHL24U",426,0) ;increment the counter tracking the number of results returned "RTN","RAHL24U",427,0) S RACNT=RACNT+1 "RTN","RAHL24U",428,0) Q "RTN","RAHL24U",429,0) ; "RTN","RAHL24U",430,0) HLA2SEG ;copy HLA("HLS",P) & HLA("HLS",P,Q) to SEG(R) "RTN","RAHL24U",431,0) K P,Q,R S (P,R)=0,SEG="",SEG(1)="xxx|" "RTN","RAHL24U",432,0) S P=$O(HLA("HLS",P)) Q:'P "RTN","RAHL24U",433,0) S R=R+1,SEG(R)=$G(HLA("HLS",P)) "RTN","RAHL24U",434,0) S Q=0 F S Q=$O(HLA("HLS",P,Q)) Q:'Q D "RTN","RAHL24U",435,0) .S R=R+1,SEG(R)=$G(HLA("HLS",P,Q)) "RTN","RAHL24U",436,0) .Q "RTN","RAHL24U",437,0) K P,Q,R "RTN","RAHL24U",438,0) QUIT "RTN","RAHL24U",439,0) ; "VER") 8.0^22.0 "BLD",7848,6) ^99 **END** **END**