HDISVAP2 ;BPFO/JRP - Application Programmer API(s);03/07/12 07:47
;;1.0;HEALTH DATA & INFORMATICS;**7**;Feb 22, 2005;Build 33
;
; THIS IS A CONTINUATION OF LABXCPT^HDISVAP1
;
BUILD(ARRAY,XMLDOC,SUMTXT) ;Build XML document for Lab exceptions
; Input: ARRAY - Array containing information about the exception
; (FULL GLOBAL REFERENCE)
; XMLDOC - Array to build XML document into
; (FULL GLOBAL REFERENCE)
; SUMTXT - Array to build summary text into
; (FULL GLOBAL REFERENCE) (Optional)
;Output: Number of exeptions added to XML document
; @XMLDOC@(1..N,0) = Line N of XML document
; @SUMTXT@(1..N,0) = Line N of summary text
; @SUMTXT@(0) = List of IDs added to XML document
; (comma separated)
; Notes: See LABXCPT^HDISVAP1 for details concerning layout of
; ARRAY and the nodes that are set to denote errors that
; were encountered while building the XML document
; : Existance and validity of required input is assumed
; : XMLDOC & SUMTXT are initialized (ie KILLed) on input
; : XMLDOC & SUMTXT will be KILLed if no exceptions are
; are added to the XML document
;
NEW XCPTTYPE,XCPTNUM,XCPTNODE,XMLNODE,XCPTADD,ERROR
NEW TAGS,TAGREF,ERRXML,SUMNODE,ERRSUM,TEXT,ERRTXT
SET TAGS=$NAME(^TMP("HDISVAP1",$JOB,"TAGS"))
SET SUMTXT=$GET(SUMTXT)
KILL @XMLDOC,@TAGS IF (SUMTXT'="") KILL @SUMTXT
SET XMLNODE=1
SET XCPTADD=0
SET SUMNODE=1
;Initialize array of XML element names
DO GETTAGS^HDISVAP3(TAGS)
;Add XML header to XML document
SET @XMLDOC@(XMLNODE,0)=$$XMLHDR^XOBVLIB()
SET XMLNODE=XMLNODE+1
;Add root element to XML document
SET TAGREF=1 DO ADDBEG
;Loop through exception type codes
SET XCPTTYPE=0
FOR SET XCPTTYPE=+$ORDER(@ARRAY@(XCPTTYPE)) QUIT:('XCPTTYPE) DO
.SET ERROR=0
.;Remember current locations in XML document & summary text
.; Needed for errors
.SET ERRXML=XMLNODE
.SET ERRSUM=SUMNODE
.;Unsupported exception type code
.IF (",1,2,3,"'[XCPTTYPE) DO QUIT
..SET XCPTNUM=0
..SET ERRTXT="Exception Type Code "_XCPTTYPE_" not supported"
..DO ERR
..QUIT
.;Loop through exceptions
.SET XCPTNUM=0
.FOR SET XCPTNUM=+$ORDER(@ARRAY@(XCPTTYPE,XCPTNUM)) QUIT:('XCPTNUM) DO
..;Remember current locations in XML document & summary text
..; Needed for errors
..SET ERRXML=XMLNODE
..SET ERRSUM=SUMNODE
..;Add begin tag to XML document
..SET TAGREF=2 DO ADDBEG
..;Build contents of XML document (also creates summary text)
..DO ADMIN QUIT:(ERROR)
..DO SNOMED QUIT:(ERROR)
..DO RSLTN QUIT:(ERROR)
..DO REFLAB QUIT:(ERROR)
..;Separator for summary text
..IF (SUMTXT'="") DO
...SET TEXT="" SET $PIECE(TEXT,"= ",40)="="
...DO SUMADD^HDISVAP3(TEXT,SUMTXT,.SUMNODE)
...DO SUMADD^HDISVAP3(" ",SUMTXT,.SUMNODE)
..;Add end tag to XML document
..SET TAGREF=2 DO ADDEND
..;Increment counter of exceptions added to XML document
..SET XCPTADD=XCPTADD+1
..;Add ID to list of IDs in summary text
..IF (SUMTXT'="") DO SUMID^HDISVAP3(SUMTXT,$NAME(@ARRAY@(XCPTTYPE,XCPTNUM,"SA")))
..QUIT
.QUIT
;End root element in XML document
SET TAGREF=1 DO ADDEND
;No exceptions added to XML document - delete it & summary text
IF ('XCPTADD) KILL @XMLDOC IF (SUMTXT'="") KILL @SUMTXT
;Done - clean up and quit
KILL @TAGS
QUIT XCPTADD
;
ADMIN ;Administrative data
NEW NODE,TMP,DATA,ARRTYPE,DELIM,TEXT
SET ERROR=0
;Add begin tag
SET TAGREF=3 DO ADDBEG
;Facility number
SET:('$$GETFAC^HDISVF07(,.TEXT)) TEXT=$$FACPTR^HDISVF01()
SET TEXT=$PIECE($$NS^XUAF4(TEXT),"^",2)
IF (TEXT="") SET TEXT=$$FACNUM^HDISVF01()
IF (TEXT="") DO QUIT
.SET ERRTXT="Unable to determine current facility number"
.DO ERR
.QUIT
SET TAGREF=3.01
DO ADD
;Facility domain/IP
SET:('$$GETDIP^HDISVF07(,.TEXT)) TEXT=$GET(^XMB("NETNAME"))
IF (TEXT="") DO QUIT
.SET ERRTXT="Unable to determine MailMan domain for this location"
.DO ERR
.QUIT
SET TAGREF=3.02
DO ADD
;System type of facility
IF ('$$GETTYPE^HDISVF07(,,.TEXT)) DO
.SET TEXT=$$PROD^XUPROD()
.SET TEXT=$SELECT(TEXT:"PRODUCTION",1:"TEST")
IF (TEXT="") DO QUIT
.SET ERRTXT="Unable to determine if this is a production or test system"
.DO ERR
.QUIT
SET TAGREF=3.03
DO ADD
;Exception type
SET TEXT=XCPTTYPE
SET TAGREF=3.04
DO ADD
;Copy into working array
SET DELIM="^"
SET NODE=$GET(@ARRAY@(XCPTTYPE,XCPTNUM))
DO PRSENODE
;Trasaction number
SET TEXT=$GET(DATA(1))
IF (TEXT="") DO QUIT
.SET ERRTXT="Transaction Number does not have a value"
.DO ERR
.QUIT
SET TAGREF=3.05
DO ADD
;Time stamp (convert to XML)
SET TEXT=$GET(DATA(2))
IF (TEXT="") DO QUIT
.SET ERRTXT="Time Stamp of exception does not have a value"
.DO ERR
.QUIT
SET TEXT=$$FMTXML^HDISVU01(TEXT,0,1)
SET TAGREF=3.06
DO ADD
;Exception text
SET TEXT=$GET(@ARRAY@(XCPTTYPE,XCPTNUM,"TXT"))
SET TAGREF=3.07
DO ADD
;Add end tag
SET TAGREF=3 DO ADDEND
;Summary text
IF (SUMTXT'="") DO SUMADMIN^HDISVAP3(SUMTXT,XCPTTYPE,.DATA,.SUMNODE)
QUIT
;
SNOMED ;SNOMED extract data
NEW NODE,SPOT,DATA,ARRTYPE,DELIM,TEXT
SET ERROR=0
;Add begin tag
SET TAGREF=4 DO ADDBEG
;Determine array format
SET ARRTYPE=$DATA(@ARRAY@(XCPTTYPE,XCPTNUM,"SA"))
;Primary and alternate format used - throw error
IF ARRTYPE=11 DO QUIT
.SET ERRTXT="Primary & alternate input formats used"
.DO ERR
.QUIT
;Primary format used
IF ARRTYPE=1 DO
.;Copy into working array
.SET DELIM="|"
.SET NODE=$GET(@ARRAY@(XCPTTYPE,XCPTNUM,"SA"))
.DO PRSENODE
.QUIT
;Alternate format used
IF ARRTYPE=10 DO
.;Copy into working array
.KILL DATA
.MERGE DATA=@ARRAY@(XCPTTYPE,XCPTNUM,"SA")
.QUIT
;Loop through data and add to document
SET NODE=0
FOR SET NODE=+$ORDER(DATA(NODE)) QUIT:('NODE) DO
.SET TEXT=DATA(NODE)
.SET TAGREF=4+(NODE*.01)
.DO ADD
.QUIT
;Add end tag
SET TAGREF=4 DO ADDEND
;Summary text
IF (SUMTXT'="") DO SUMSNOMD^HDISVAP3(SUMTXT,.DATA,.SUMNODE)
QUIT
;
RSLTN ;Resolution data
NEW NODE,SPOT,DATA,ARRTYPE,DELIM,TEXT
SET ERROR=0
;Add begin tag
SET TAGREF=5 DO ADDBEG
;Resolution data sent to site (load exceptions only)
IF (XCPTTYPE=1) DO QUIT:(ERROR)
.;Determine array format
.SET ARRTYPE=$DATA(@ARRAY@(XCPTTYPE,XCPTNUM,"RD"))
.;Primary and alternate format used - throw error
.IF ARRTYPE=11 DO QUIT
..SET ERRTXT="Primary & alternate input formats used"
..DO ERR
..QUIT
.;Primary format used
.IF ARRTYPE=1 DO
..;Copy into working array
..SET DELIM="|"
..SET NODE=$GET(@ARRAY@(XCPTTYPE,XCPTNUM,"RD"))
..DO PRSENODE
..QUIT
.;Alternate format used
.IF ARRTYPE=10 DO
..;Copy into working array
..KILL DATA
..MERGE DATA=@ARRAY@(XCPTTYPE,XCPTNUM,"RD")
..QUIT
.;Loop through data and add to document
.SET NODE=0
.FOR SET NODE=+$ORDER(DATA(NODE)) QUIT:('NODE) DO
..SET TEXT=DATA(NODE)
..SET TAGREF=5+(NODE*.01)
..DO ADD
..QUIT
.QUIT
;Doesn't apply to exception type - send empty elements
IF (XCPTTYPE'=1) DO
.SET TEXT=""
.FOR TAGREF=5.01:.01:5.06 DO ADD
.QUIT
;Add end tag
SET TAGREF=5 DO ADDEND
QUIT
;
REFLAB ;Reference lab data
NEW NODE,DATA,ARRTYPE,DELIM,TEXT
SET ERROR=0
;Add begin tag
SET TAGREF=6 DO ADDBEG
;Reference lab data (reference lab exceptions only)
IF (XCPTTYPE=2) DO QUIT:(ERROR)
.;Determine array format
.SET ARRTYPE=$DATA(@ARRAY@(XCPTTYPE,XCPTNUM,"RL"))
.;Primary and alternate format used - throw error
.IF ARRTYPE=11 DO QUIT
..SET ERRTXT="Primary & alternate input formats used"
..DO ERR
..QUIT
.;Primary format used
.IF ARRTYPE=1 DO
..;Copy into working array
..SET DELIM="^"
..SET NODE=$GET(@ARRAY@(XCPTTYPE,XCPTNUM,"RL"))
..DO PRSENODE
..QUIT
.;Alternate format used
.IF ARRTYPE=10 DO
..;Copy into working array
..KILL DATA
..MERGE DATA=@ARRAY@(XCPTTYPE,XCPTNUM,"RL")
..QUIT
.;Lab type code
.SET TEXT=$GET(DATA(1))
.IF (TEXT="") DO QUIT
..SET ERRTXT="Location Type Code of reference lab does not have a value"
..DO ERR
..QUIT
.IF (",1,2,3,4,5,6,"'[TEXT) DO QUIT
..SET ERRTXT="Location Type Code of reference lab does not have a valid value"
..DO ERR
..QUIT
.SET TAGREF=6.01
.DO ADD
.;Lab station number
.SET TEXT=$GET(DATA(2))
.IF (TEXT="") DO QUIT
..SET ERRTXT="Location Number of reference lab does not have a value"
..DO ERR
..QUIT
.SET TAGREF=6.02
.DO ADD
.;Lab name
.SET TEXT=$GET(DATA(3))
.IF (TEXT="") DO QUIT
..SET ERRTXT="Location Name of reference lab does not have a value"
..DO ERR
..QUIT
.SET TAGREF=6.03
.DO ADD
.;OBX-3
.SET TEXT=$GET(@ARRAY@(XCPTTYPE,XCPTNUM,"OBX",3))
.SET TAGREF=6.04
.DO ADD
.;OBX-5
.SET TEXT=$GET(@ARRAY@(XCPTTYPE,XCPTNUM,"OBX",5))
.SET TAGREF=6.05
.DO ADD
.;Summary text
.IF (SUMTXT'="") DO SUMRFLAB^HDISVAP3(SUMTXT,.DATA,.SUMNODE)
.QUIT
;Doesn't apply to exception type - send empty elements
IF (XCPTTYPE'=2) DO
.SET TEXT=""
.FOR TAGREF=6.01:.01:6.05 DO ADD
.QUIT
;Add end tag
SET TAGREF=6 DO ADDEND
QUIT
;
ADD ;Add text to XML document
NEW TAGNAME
;Get element name
SET TAGNAME=$GET(@TAGS@(TAGREF))
IF (TAGNAME="") QUIT
;Add text
DO ADD^HDISVAP3(TEXT,TAGNAME,XMLDOC,.XMLNODE)
QUIT
;
ADDBEG ; Add beginning tag to XML document
NEW TAGNAME
;Get element name
SET TAGNAME=$GET(@TAGS@(TAGREF))
IF (TAGNAME="") QUIT
;Add beginning tag
DO ADDBEG^HDISVAP3(TAGNAME,XMLDOC,.XMLNODE)
QUIT
;
ADDEND ;Add ending tag to XML document
NEW TAGNAME
;Get element name
SET TAGNAME=$GET(@TAGS@(TAGREF))
IF (TAGNAME="") QUIT
;Add closing tag
DO ADDEND^HDISVAP3(TAGNAME,XMLDOC,.XMLNODE)
QUIT
;
PRSENODE ;Parse delimited data in NODE into individual pieces
NEW LOOP
KILL DATA
FOR LOOP=1:1:$LENGTH(NODE,DELIM) DO
.SET DATA(LOOP)=$PIECE(NODE,DELIM,LOOP)
QUIT
;
ERR ;Error found
NEW X
;Remove data from XML document
FOR X=ERRXML:1:XMLNODE KILL @XMLDOC@(X)
;Remove data from summary text
IF (SUMTXT'="") DO
.FOR X=ERRSUM:1:SUMNODE KILL @SUMTXT@(X)
;Log exception
IF ($GET(XCPTNUM)) SET @ARRAY@("ERROR",XCPTTYPE,XCPTNUM)=ERRTXT
IF ('$GET(XCPTNUM)) SET @ARRAY@("ERROR",XCPTTYPE)=ERRTXT
;Reset insertion points
SET XMLNODE=ERRXML
SET SUMNODE=ERRSUM
;Set error flag
SET ERROR=1
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDISVAP2 10380 printed Sep 23, 2025@19:32:44 Page 2
HDISVAP2 ;BPFO/JRP - Application Programmer API(s);03/07/12 07:47
+1 ;;1.0;HEALTH DATA & INFORMATICS;**7**;Feb 22, 2005;Build 33
+2 ;
+3 ; THIS IS A CONTINUATION OF LABXCPT^HDISVAP1
+4 ;
BUILD(ARRAY,XMLDOC,SUMTXT) ;Build XML document for Lab exceptions
+1 ; Input: ARRAY - Array containing information about the exception
+2 ; (FULL GLOBAL REFERENCE)
+3 ; XMLDOC - Array to build XML document into
+4 ; (FULL GLOBAL REFERENCE)
+5 ; SUMTXT - Array to build summary text into
+6 ; (FULL GLOBAL REFERENCE) (Optional)
+7 ;Output: Number of exeptions added to XML document
+8 ; @XMLDOC@(1..N,0) = Line N of XML document
+9 ; @SUMTXT@(1..N,0) = Line N of summary text
+10 ; @SUMTXT@(0) = List of IDs added to XML document
+11 ; (comma separated)
+12 ; Notes: See LABXCPT^HDISVAP1 for details concerning layout of
+13 ; ARRAY and the nodes that are set to denote errors that
+14 ; were encountered while building the XML document
+15 ; : Existance and validity of required input is assumed
+16 ; : XMLDOC & SUMTXT are initialized (ie KILLed) on input
+17 ; : XMLDOC & SUMTXT will be KILLed if no exceptions are
+18 ; are added to the XML document
+19 ;
+20 NEW XCPTTYPE,XCPTNUM,XCPTNODE,XMLNODE,XCPTADD,ERROR
+21 NEW TAGS,TAGREF,ERRXML,SUMNODE,ERRSUM,TEXT,ERRTXT
+22 SET TAGS=$NAME(^TMP("HDISVAP1",$JOB,"TAGS"))
+23 SET SUMTXT=$GET(SUMTXT)
+24 KILL @XMLDOC,@TAGS
IF (SUMTXT'="")
KILL @SUMTXT
+25 SET XMLNODE=1
+26 SET XCPTADD=0
+27 SET SUMNODE=1
+28 ;Initialize array of XML element names
+29 DO GETTAGS^HDISVAP3(TAGS)
+30 ;Add XML header to XML document
+31 SET @XMLDOC@(XMLNODE,0)=$$XMLHDR^XOBVLIB()
+32 SET XMLNODE=XMLNODE+1
+33 ;Add root element to XML document
+34 SET TAGREF=1
DO ADDBEG
+35 ;Loop through exception type codes
+36 SET XCPTTYPE=0
+37 FOR
SET XCPTTYPE=+$ORDER(@ARRAY@(XCPTTYPE))
if ('XCPTTYPE)
QUIT
Begin DoDot:1
+38 SET ERROR=0
+39 ;Remember current locations in XML document & summary text
+40 ; Needed for errors
+41 SET ERRXML=XMLNODE
+42 SET ERRSUM=SUMNODE
+43 ;Unsupported exception type code
+44 IF (",1,2,3,"'[XCPTTYPE)
Begin DoDot:2
+45 SET XCPTNUM=0
+46 SET ERRTXT="Exception Type Code "_XCPTTYPE_" not supported"
+47 DO ERR
+48 QUIT
End DoDot:2
QUIT
+49 ;Loop through exceptions
+50 SET XCPTNUM=0
+51 FOR
SET XCPTNUM=+$ORDER(@ARRAY@(XCPTTYPE,XCPTNUM))
if ('XCPTNUM)
QUIT
Begin DoDot:2
+52 ;Remember current locations in XML document & summary text
+53 ; Needed for errors
+54 SET ERRXML=XMLNODE
+55 SET ERRSUM=SUMNODE
+56 ;Add begin tag to XML document
+57 SET TAGREF=2
DO ADDBEG
+58 ;Build contents of XML document (also creates summary text)
+59 DO ADMIN
if (ERROR)
QUIT
+60 DO SNOMED
if (ERROR)
QUIT
+61 DO RSLTN
if (ERROR)
QUIT
+62 DO REFLAB
if (ERROR)
QUIT
+63 ;Separator for summary text
+64 IF (SUMTXT'="")
Begin DoDot:3
+65 SET TEXT=""
SET $PIECE(TEXT,"= ",40)="="
+66 DO SUMADD^HDISVAP3(TEXT,SUMTXT,.SUMNODE)
+67 DO SUMADD^HDISVAP3(" ",SUMTXT,.SUMNODE)
End DoDot:3
+68 ;Add end tag to XML document
+69 SET TAGREF=2
DO ADDEND
+70 ;Increment counter of exceptions added to XML document
+71 SET XCPTADD=XCPTADD+1
+72 ;Add ID to list of IDs in summary text
+73 IF (SUMTXT'="")
DO SUMID^HDISVAP3(SUMTXT,$NAME(@ARRAY@(XCPTTYPE,XCPTNUM,"SA")))
+74 QUIT
End DoDot:2
+75 QUIT
End DoDot:1
+76 ;End root element in XML document
+77 SET TAGREF=1
DO ADDEND
+78 ;No exceptions added to XML document - delete it & summary text
+79 IF ('XCPTADD)
KILL @XMLDOC
IF (SUMTXT'="")
KILL @SUMTXT
+80 ;Done - clean up and quit
+81 KILL @TAGS
+82 QUIT XCPTADD
+83 ;
ADMIN ;Administrative data
+1 NEW NODE,TMP,DATA,ARRTYPE,DELIM,TEXT
+2 SET ERROR=0
+3 ;Add begin tag
+4 SET TAGREF=3
DO ADDBEG
+5 ;Facility number
+6 if ('$$GETFAC^HDISVF07(,.TEXT))
SET TEXT=$$FACPTR^HDISVF01()
+7 SET TEXT=$PIECE($$NS^XUAF4(TEXT),"^",2)
+8 IF (TEXT="")
SET TEXT=$$FACNUM^HDISVF01()
+9 IF (TEXT="")
Begin DoDot:1
+10 SET ERRTXT="Unable to determine current facility number"
+11 DO ERR
+12 QUIT
End DoDot:1
QUIT
+13 SET TAGREF=3.01
+14 DO ADD
+15 ;Facility domain/IP
+16 if ('$$GETDIP^HDISVF07(,.TEXT))
SET TEXT=$GET(^XMB("NETNAME"))
+17 IF (TEXT="")
Begin DoDot:1
+18 SET ERRTXT="Unable to determine MailMan domain for this location"
+19 DO ERR
+20 QUIT
End DoDot:1
QUIT
+21 SET TAGREF=3.02
+22 DO ADD
+23 ;System type of facility
+24 IF ('$$GETTYPE^HDISVF07(,,.TEXT))
Begin DoDot:1
+25 SET TEXT=$$PROD^XUPROD()
+26 SET TEXT=$SELECT(TEXT:"PRODUCTION",1:"TEST")
End DoDot:1
+27 IF (TEXT="")
Begin DoDot:1
+28 SET ERRTXT="Unable to determine if this is a production or test system"
+29 DO ERR
+30 QUIT
End DoDot:1
QUIT
+31 SET TAGREF=3.03
+32 DO ADD
+33 ;Exception type
+34 SET TEXT=XCPTTYPE
+35 SET TAGREF=3.04
+36 DO ADD
+37 ;Copy into working array
+38 SET DELIM="^"
+39 SET NODE=$GET(@ARRAY@(XCPTTYPE,XCPTNUM))
+40 DO PRSENODE
+41 ;Trasaction number
+42 SET TEXT=$GET(DATA(1))
+43 IF (TEXT="")
Begin DoDot:1
+44 SET ERRTXT="Transaction Number does not have a value"
+45 DO ERR
+46 QUIT
End DoDot:1
QUIT
+47 SET TAGREF=3.05
+48 DO ADD
+49 ;Time stamp (convert to XML)
+50 SET TEXT=$GET(DATA(2))
+51 IF (TEXT="")
Begin DoDot:1
+52 SET ERRTXT="Time Stamp of exception does not have a value"
+53 DO ERR
+54 QUIT
End DoDot:1
QUIT
+55 SET TEXT=$$FMTXML^HDISVU01(TEXT,0,1)
+56 SET TAGREF=3.06
+57 DO ADD
+58 ;Exception text
+59 SET TEXT=$GET(@ARRAY@(XCPTTYPE,XCPTNUM,"TXT"))
+60 SET TAGREF=3.07
+61 DO ADD
+62 ;Add end tag
+63 SET TAGREF=3
DO ADDEND
+64 ;Summary text
+65 IF (SUMTXT'="")
DO SUMADMIN^HDISVAP3(SUMTXT,XCPTTYPE,.DATA,.SUMNODE)
+66 QUIT
+67 ;
SNOMED ;SNOMED extract data
+1 NEW NODE,SPOT,DATA,ARRTYPE,DELIM,TEXT
+2 SET ERROR=0
+3 ;Add begin tag
+4 SET TAGREF=4
DO ADDBEG
+5 ;Determine array format
+6 SET ARRTYPE=$DATA(@ARRAY@(XCPTTYPE,XCPTNUM,"SA"))
+7 ;Primary and alternate format used - throw error
+8 IF ARRTYPE=11
Begin DoDot:1
+9 SET ERRTXT="Primary & alternate input formats used"
+10 DO ERR
+11 QUIT
End DoDot:1
QUIT
+12 ;Primary format used
+13 IF ARRTYPE=1
Begin DoDot:1
+14 ;Copy into working array
+15 SET DELIM="|"
+16 SET NODE=$GET(@ARRAY@(XCPTTYPE,XCPTNUM,"SA"))
+17 DO PRSENODE
+18 QUIT
End DoDot:1
+19 ;Alternate format used
+20 IF ARRTYPE=10
Begin DoDot:1
+21 ;Copy into working array
+22 KILL DATA
+23 MERGE DATA=@ARRAY@(XCPTTYPE,XCPTNUM,"SA")
+24 QUIT
End DoDot:1
+25 ;Loop through data and add to document
+26 SET NODE=0
+27 FOR
SET NODE=+$ORDER(DATA(NODE))
if ('NODE)
QUIT
Begin DoDot:1
+28 SET TEXT=DATA(NODE)
+29 SET TAGREF=4+(NODE*.01)
+30 DO ADD
+31 QUIT
End DoDot:1
+32 ;Add end tag
+33 SET TAGREF=4
DO ADDEND
+34 ;Summary text
+35 IF (SUMTXT'="")
DO SUMSNOMD^HDISVAP3(SUMTXT,.DATA,.SUMNODE)
+36 QUIT
+37 ;
RSLTN ;Resolution data
+1 NEW NODE,SPOT,DATA,ARRTYPE,DELIM,TEXT
+2 SET ERROR=0
+3 ;Add begin tag
+4 SET TAGREF=5
DO ADDBEG
+5 ;Resolution data sent to site (load exceptions only)
+6 IF (XCPTTYPE=1)
Begin DoDot:1
+7 ;Determine array format
+8 SET ARRTYPE=$DATA(@ARRAY@(XCPTTYPE,XCPTNUM,"RD"))
+9 ;Primary and alternate format used - throw error
+10 IF ARRTYPE=11
Begin DoDot:2
+11 SET ERRTXT="Primary & alternate input formats used"
+12 DO ERR
+13 QUIT
End DoDot:2
QUIT
+14 ;Primary format used
+15 IF ARRTYPE=1
Begin DoDot:2
+16 ;Copy into working array
+17 SET DELIM="|"
+18 SET NODE=$GET(@ARRAY@(XCPTTYPE,XCPTNUM,"RD"))
+19 DO PRSENODE
+20 QUIT
End DoDot:2
+21 ;Alternate format used
+22 IF ARRTYPE=10
Begin DoDot:2
+23 ;Copy into working array
+24 KILL DATA
+25 MERGE DATA=@ARRAY@(XCPTTYPE,XCPTNUM,"RD")
+26 QUIT
End DoDot:2
+27 ;Loop through data and add to document
+28 SET NODE=0
+29 FOR
SET NODE=+$ORDER(DATA(NODE))
if ('NODE)
QUIT
Begin DoDot:2
+30 SET TEXT=DATA(NODE)
+31 SET TAGREF=5+(NODE*.01)
+32 DO ADD
+33 QUIT
End DoDot:2
+34 QUIT
End DoDot:1
if (ERROR)
QUIT
+35 ;Doesn't apply to exception type - send empty elements
+36 IF (XCPTTYPE'=1)
Begin DoDot:1
+37 SET TEXT=""
+38 FOR TAGREF=5.01:.01:5.06
DO ADD
+39 QUIT
End DoDot:1
+40 ;Add end tag
+41 SET TAGREF=5
DO ADDEND
+42 QUIT
+43 ;
REFLAB ;Reference lab data
+1 NEW NODE,DATA,ARRTYPE,DELIM,TEXT
+2 SET ERROR=0
+3 ;Add begin tag
+4 SET TAGREF=6
DO ADDBEG
+5 ;Reference lab data (reference lab exceptions only)
+6 IF (XCPTTYPE=2)
Begin DoDot:1
+7 ;Determine array format
+8 SET ARRTYPE=$DATA(@ARRAY@(XCPTTYPE,XCPTNUM,"RL"))
+9 ;Primary and alternate format used - throw error
+10 IF ARRTYPE=11
Begin DoDot:2
+11 SET ERRTXT="Primary & alternate input formats used"
+12 DO ERR
+13 QUIT
End DoDot:2
QUIT
+14 ;Primary format used
+15 IF ARRTYPE=1
Begin DoDot:2
+16 ;Copy into working array
+17 SET DELIM="^"
+18 SET NODE=$GET(@ARRAY@(XCPTTYPE,XCPTNUM,"RL"))
+19 DO PRSENODE
+20 QUIT
End DoDot:2
+21 ;Alternate format used
+22 IF ARRTYPE=10
Begin DoDot:2
+23 ;Copy into working array
+24 KILL DATA
+25 MERGE DATA=@ARRAY@(XCPTTYPE,XCPTNUM,"RL")
+26 QUIT
End DoDot:2
+27 ;Lab type code
+28 SET TEXT=$GET(DATA(1))
+29 IF (TEXT="")
Begin DoDot:2
+30 SET ERRTXT="Location Type Code of reference lab does not have a value"
+31 DO ERR
+32 QUIT
End DoDot:2
QUIT
+33 IF (",1,2,3,4,5,6,"'[TEXT)
Begin DoDot:2
+34 SET ERRTXT="Location Type Code of reference lab does not have a valid value"
+35 DO ERR
+36 QUIT
End DoDot:2
QUIT
+37 SET TAGREF=6.01
+38 DO ADD
+39 ;Lab station number
+40 SET TEXT=$GET(DATA(2))
+41 IF (TEXT="")
Begin DoDot:2
+42 SET ERRTXT="Location Number of reference lab does not have a value"
+43 DO ERR
+44 QUIT
End DoDot:2
QUIT
+45 SET TAGREF=6.02
+46 DO ADD
+47 ;Lab name
+48 SET TEXT=$GET(DATA(3))
+49 IF (TEXT="")
Begin DoDot:2
+50 SET ERRTXT="Location Name of reference lab does not have a value"
+51 DO ERR
+52 QUIT
End DoDot:2
QUIT
+53 SET TAGREF=6.03
+54 DO ADD
+55 ;OBX-3
+56 SET TEXT=$GET(@ARRAY@(XCPTTYPE,XCPTNUM,"OBX",3))
+57 SET TAGREF=6.04
+58 DO ADD
+59 ;OBX-5
+60 SET TEXT=$GET(@ARRAY@(XCPTTYPE,XCPTNUM,"OBX",5))
+61 SET TAGREF=6.05
+62 DO ADD
+63 ;Summary text
+64 IF (SUMTXT'="")
DO SUMRFLAB^HDISVAP3(SUMTXT,.DATA,.SUMNODE)
+65 QUIT
End DoDot:1
if (ERROR)
QUIT
+66 ;Doesn't apply to exception type - send empty elements
+67 IF (XCPTTYPE'=2)
Begin DoDot:1
+68 SET TEXT=""
+69 FOR TAGREF=6.01:.01:6.05
DO ADD
+70 QUIT
End DoDot:1
+71 ;Add end tag
+72 SET TAGREF=6
DO ADDEND
+73 QUIT
+74 ;
ADD ;Add text to XML document
+1 NEW TAGNAME
+2 ;Get element name
+3 SET TAGNAME=$GET(@TAGS@(TAGREF))
+4 IF (TAGNAME="")
QUIT
+5 ;Add text
+6 DO ADD^HDISVAP3(TEXT,TAGNAME,XMLDOC,.XMLNODE)
+7 QUIT
+8 ;
ADDBEG ; Add beginning tag to XML document
+1 NEW TAGNAME
+2 ;Get element name
+3 SET TAGNAME=$GET(@TAGS@(TAGREF))
+4 IF (TAGNAME="")
QUIT
+5 ;Add beginning tag
+6 DO ADDBEG^HDISVAP3(TAGNAME,XMLDOC,.XMLNODE)
+7 QUIT
+8 ;
ADDEND ;Add ending tag to XML document
+1 NEW TAGNAME
+2 ;Get element name
+3 SET TAGNAME=$GET(@TAGS@(TAGREF))
+4 IF (TAGNAME="")
QUIT
+5 ;Add closing tag
+6 DO ADDEND^HDISVAP3(TAGNAME,XMLDOC,.XMLNODE)
+7 QUIT
+8 ;
PRSENODE ;Parse delimited data in NODE into individual pieces
+1 NEW LOOP
+2 KILL DATA
+3 FOR LOOP=1:1:$LENGTH(NODE,DELIM)
Begin DoDot:1
+4 SET DATA(LOOP)=$PIECE(NODE,DELIM,LOOP)
End DoDot:1
+5 QUIT
+6 ;
ERR ;Error found
+1 NEW X
+2 ;Remove data from XML document
+3 FOR X=ERRXML:1:XMLNODE
KILL @XMLDOC@(X)
+4 ;Remove data from summary text
+5 IF (SUMTXT'="")
Begin DoDot:1
+6 FOR X=ERRSUM:1:SUMNODE
KILL @SUMTXT@(X)
End DoDot:1
+7 ;Log exception
+8 IF ($GET(XCPTNUM))
SET @ARRAY@("ERROR",XCPTTYPE,XCPTNUM)=ERRTXT
+9 IF ('$GET(XCPTNUM))
SET @ARRAY@("ERROR",XCPTTYPE)=ERRTXT
+10 ;Reset insertion points
+11 SET XMLNODE=ERRXML
+12 SET SUMNODE=ERRSUM
+13 ;Set error flag
+14 SET ERROR=1
+15 QUIT
