Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HDISVAP2

HDISVAP2.m

Go to the documentation of this file. 
  1. HDISVAP2 ;BPFO/JRP - Application Programmer API(s);03/07/12  07:47
  1.  ;;1.0;HEALTH DATA & INFORMATICS;**7**;Feb 22, 2005;Build 33
  1.  ;
  1.  ; THIS IS A CONTINUATION OF LABXCPT^HDISVAP1
  1.  ;
  1. BUILD(ARRAY,XMLDOC,SUMTXT) ;Build XML document for Lab exceptions
  1.  ; Input: ARRAY - Array containing information about the exception
  1.  ;                (FULL GLOBAL REFERENCE)
  1.  ;        XMLDOC - Array to build XML document into
  1.  ;                 (FULL GLOBAL REFERENCE)
  1.  ;        SUMTXT - Array to build summary text into
  1.  ;                 (FULL GLOBAL REFERENCE) (Optional)
  1.  ;Output: Number of exeptions added to XML document
  1.  ;        @XMLDOC@(1..N,0) = Line N of XML document
  1.  ;        @SUMTXT@(1..N,0) = Line N of summary text
  1.  ;        @SUMTXT@(0) = List of IDs added to XML document
  1.  ;                      (comma separated)
  1.  ; Notes: See LABXCPT^HDISVAP1 for details concerning layout of
  1.  ;        ARRAY and the nodes that are set to denote errors that
  1.  ;        were encountered while building the XML document
  1.  ;      : Existance and validity of required input is assumed
  1.  ;      : XMLDOC & SUMTXT are initialized (ie KILLed) on input
  1.  ;      : XMLDOC & SUMTXT will be KILLed if no exceptions are
  1.  ;        are added to the XML document
  1.  ;
  1.  NEW XCPTTYPE,XCPTNUM,XCPTNODE,XMLNODE,XCPTADD,ERROR
  1.  NEW TAGS,TAGREF,ERRXML,SUMNODE,ERRSUM,TEXT,ERRTXT
  1.  SET TAGS=$NAME(^TMP("HDISVAP1",$JOB,"TAGS"))
  1.  SET SUMTXT=$GET(SUMTXT)
  1.  KILL @XMLDOC,@TAGS IF (SUMTXT'="") KILL @SUMTXT
  1.  SET XMLNODE=1
  1.  SET XCPTADD=0
  1.  SET SUMNODE=1
  1.  ;Initialize array of XML element names
  1.  DO GETTAGS^HDISVAP3(TAGS)
  1.  ;Add XML header to XML document
  1.  SET @XMLDOC@(XMLNODE,0)=$$XMLHDR^XOBVLIB()
  1.  SET XMLNODE=XMLNODE+1
  1.  ;Add root element to XML document
  1.  SET TAGREF=1 DO ADDBEG
  1.  ;Loop through exception type codes
  1.  SET XCPTTYPE=0
  1.  FOR  SET XCPTTYPE=+$ORDER(@ARRAY@(XCPTTYPE)) QUIT:('XCPTTYPE)  DO
  1.  .SET ERROR=0
  1.  .;Remember current locations in XML document & summary text
  1.  .; Needed for errors
  1.  .SET ERRXML=XMLNODE
  1.  .SET ERRSUM=SUMNODE
  1.  .;Unsupported exception type code
  1.  .IF (",1,2,3,"'[XCPTTYPE) DO  QUIT
  1.  ..SET XCPTNUM=0
  1.  ..SET ERRTXT="Exception Type Code "_XCPTTYPE_" not supported"
  1.  ..DO ERR
  1.  ..QUIT
  1.  .;Loop through exceptions
  1.  .SET XCPTNUM=0
  1.  .FOR  SET XCPTNUM=+$ORDER(@ARRAY@(XCPTTYPE,XCPTNUM)) QUIT:('XCPTNUM)  DO
  1.  ..;Remember current locations in XML document & summary text
  1.  ..; Needed for errors
  1.  ..SET ERRXML=XMLNODE
  1.  ..SET ERRSUM=SUMNODE
  1.  ..;Add begin tag to XML document
  1.  ..SET TAGREF=2 DO ADDBEG
  1.  ..;Build contents of XML document (also creates summary text)
  1.  ..DO ADMIN QUIT:(ERROR)
  1.  ..DO SNOMED QUIT:(ERROR)
  1.  ..DO RSLTN QUIT:(ERROR)
  1.  ..DO REFLAB QUIT:(ERROR)
  1.  ..;Separator for summary text
  1.  ..IF (SUMTXT'="") DO
  1.  ...SET TEXT="" SET $PIECE(TEXT,"= ",40)="="
  1.  ...DO SUMADD^HDISVAP3(TEXT,SUMTXT,.SUMNODE)
  1.  ...DO SUMADD^HDISVAP3(" ",SUMTXT,.SUMNODE)
  1.  ..;Add end tag to XML document
  1.  ..SET TAGREF=2 DO ADDEND
  1.  ..;Increment counter of exceptions added to XML document
  1.  ..SET XCPTADD=XCPTADD+1
  1.  ..;Add ID to list of IDs in summary text
  1.  ..IF (SUMTXT'="") DO SUMID^HDISVAP3(SUMTXT,$NAME(@ARRAY@(XCPTTYPE,XCPTNUM,"SA")))
  1.  ..QUIT
  1.  .QUIT
  1.  ;End root element in XML document
  1.  SET TAGREF=1 DO ADDEND
  1.  ;No exceptions added to XML document - delete it & summary text
  1.  IF ('XCPTADD) KILL @XMLDOC IF (SUMTXT'="") KILL @SUMTXT
  1.  ;Done - clean up and quit
  1.  KILL @TAGS
  1.  QUIT XCPTADD
  1.  ;
  1. ADMIN ;Administrative data
  1.  NEW NODE,TMP,DATA,ARRTYPE,DELIM,TEXT
  1.  SET ERROR=0
  1.  ;Add begin tag
  1.  SET TAGREF=3 DO ADDBEG
  1.  ;Facility number
  1.  SET:('$$GETFAC^HDISVF07(,.TEXT)) TEXT=$$FACPTR^HDISVF01()
  1.  SET TEXT=$PIECE($$NS^XUAF4(TEXT),"^",2)
  1.  IF (TEXT="") SET TEXT=$$FACNUM^HDISVF01()
  1.  IF (TEXT="") DO  QUIT
  1.  .SET ERRTXT="Unable to determine current facility number"
  1.  .DO ERR
  1.  .QUIT
  1.  SET TAGREF=3.01
  1.  DO ADD
  1.  ;Facility domain/IP
  1.  SET:('$$GETDIP^HDISVF07(,.TEXT)) TEXT=$GET(^XMB("NETNAME"))
  1.  IF (TEXT="") DO  QUIT
  1.  .SET ERRTXT="Unable to determine MailMan domain for this location"
  1.  .DO ERR
  1.  .QUIT
  1.  SET TAGREF=3.02
  1.  DO ADD
  1.  ;System type of facility
  1.  IF ('$$GETTYPE^HDISVF07(,,.TEXT)) DO
  1.  .SET TEXT=$$PROD^XUPROD()
  1.  .SET TEXT=$SELECT(TEXT:"PRODUCTION",1:"TEST")
  1.  IF (TEXT="") DO  QUIT
  1.  .SET ERRTXT="Unable to determine if this is a production or test system"
  1.  .DO ERR
  1.  .QUIT
  1.  SET TAGREF=3.03
  1.  DO ADD
  1.  ;Exception type
  1.  SET TEXT=XCPTTYPE
  1.  SET TAGREF=3.04
  1.  DO ADD
  1.  ;Copy into working array
  1.  SET DELIM="^"
  1.  SET NODE=$GET(@ARRAY@(XCPTTYPE,XCPTNUM))
  1.  DO PRSENODE
  1.  ;Trasaction number
  1.  SET TEXT=$GET(DATA(1))
  1.  IF (TEXT="") DO  QUIT
  1.  .SET ERRTXT="Transaction Number does not have a value"
  1.  .DO ERR
  1.  .QUIT
  1.  SET TAGREF=3.05
  1.  DO ADD
  1.  ;Time stamp (convert to XML)
  1.  SET TEXT=$GET(DATA(2))
  1.  IF (TEXT="") DO  QUIT
  1.  .SET ERRTXT="Time Stamp of exception does not have a value"
  1.  .DO ERR
  1.  .QUIT
  1.  SET TEXT=$$FMTXML^HDISVU01(TEXT,0,1)
  1.  SET TAGREF=3.06
  1.  DO ADD
  1.  ;Exception text
  1.  SET TEXT=$GET(@ARRAY@(XCPTTYPE,XCPTNUM,"TXT"))
  1.  SET TAGREF=3.07
  1.  DO ADD
  1.  ;Add end tag
  1.  SET TAGREF=3 DO ADDEND
  1.  ;Summary text
  1.  IF (SUMTXT'="") DO SUMADMIN^HDISVAP3(SUMTXT,XCPTTYPE,.DATA,.SUMNODE)
  1.  QUIT
  1.  ;
  1. SNOMED ;SNOMED extract data
  1.  NEW NODE,SPOT,DATA,ARRTYPE,DELIM,TEXT
  1.  SET ERROR=0
  1.  ;Add begin tag
  1.  SET TAGREF=4 DO ADDBEG
  1.  ;Determine array format
  1.  SET ARRTYPE=$DATA(@ARRAY@(XCPTTYPE,XCPTNUM,"SA"))
  1.  ;Primary and alternate format used - throw error
  1.  IF ARRTYPE=11 DO  QUIT
  1.  .SET ERRTXT="Primary & alternate input formats used"
  1.  .DO ERR
  1.  .QUIT
  1.  ;Primary format used
  1.  IF ARRTYPE=1 DO
  1.  .;Copy into working array
  1.  .SET DELIM="|"
  1.  .SET NODE=$GET(@ARRAY@(XCPTTYPE,XCPTNUM,"SA"))
  1.  .DO PRSENODE
  1.  .QUIT
  1.  ;Alternate format used
  1.  IF ARRTYPE=10 DO
  1.  .;Copy into working array
  1.  .KILL DATA
  1.  .MERGE DATA=@ARRAY@(XCPTTYPE,XCPTNUM,"SA")
  1.  .QUIT
  1.  ;Loop through data and add to document
  1.  SET NODE=0
  1.  FOR  SET NODE=+$ORDER(DATA(NODE)) QUIT:('NODE)  DO
  1.  .SET TEXT=DATA(NODE)
  1.  .SET TAGREF=4+(NODE*.01)
  1.  .DO ADD
  1.  .QUIT
  1.  ;Add end tag
  1.  SET TAGREF=4 DO ADDEND
  1.  ;Summary text
  1.  IF (SUMTXT'="") DO SUMSNOMD^HDISVAP3(SUMTXT,.DATA,.SUMNODE)
  1.  QUIT
  1.  ;
  1. RSLTN ;Resolution data
  1.  NEW NODE,SPOT,DATA,ARRTYPE,DELIM,TEXT
  1.  SET ERROR=0
  1.  ;Add begin tag
  1.  SET TAGREF=5 DO ADDBEG
  1.  ;Resolution data sent to site (load exceptions only)
  1.  IF (XCPTTYPE=1) DO  QUIT:(ERROR)
  1.  .;Determine array format
  1.  .SET ARRTYPE=$DATA(@ARRAY@(XCPTTYPE,XCPTNUM,"RD"))
  1.  .;Primary and alternate format used - throw error
  1.  .IF ARRTYPE=11 DO  QUIT
  1.  ..SET ERRTXT="Primary & alternate input formats used"
  1.  ..DO ERR
  1.  ..QUIT
  1.  .;Primary format used
  1.  .IF ARRTYPE=1 DO
  1.  ..;Copy into working array
  1.  ..SET DELIM="|"
  1.  ..SET NODE=$GET(@ARRAY@(XCPTTYPE,XCPTNUM,"RD"))
  1.  ..DO PRSENODE
  1.  ..QUIT
  1.  .;Alternate format used
  1.  .IF ARRTYPE=10 DO
  1.  ..;Copy into working array
  1.  ..KILL DATA
  1.  ..MERGE DATA=@ARRAY@(XCPTTYPE,XCPTNUM,"RD")
  1.  ..QUIT
  1.  .;Loop through data and add to document
  1.  .SET NODE=0
  1.  .FOR  SET NODE=+$ORDER(DATA(NODE)) QUIT:('NODE)  DO
  1.  ..SET TEXT=DATA(NODE)
  1.  ..SET TAGREF=5+(NODE*.01)
  1.  ..DO ADD
  1.  ..QUIT
  1.  .QUIT
  1.  ;Doesn't apply to exception type - send empty elements
  1.  IF (XCPTTYPE'=1) DO
  1.  .SET TEXT=""
  1.  .FOR TAGREF=5.01:.01:5.06 DO ADD
  1.  .QUIT
  1.  ;Add end tag
  1.  SET TAGREF=5 DO ADDEND
  1.  QUIT
  1.  ;
  1. REFLAB ;Reference lab data
  1.  NEW NODE,DATA,ARRTYPE,DELIM,TEXT
  1.  SET ERROR=0
  1.  ;Add begin tag
  1.  SET TAGREF=6 DO ADDBEG
  1.  ;Reference lab data (reference lab exceptions only)
  1.  IF (XCPTTYPE=2) DO  QUIT:(ERROR)
  1.  .;Determine array format
  1.  .SET ARRTYPE=$DATA(@ARRAY@(XCPTTYPE,XCPTNUM,"RL"))
  1.  .;Primary and alternate format used - throw error
  1.  .IF ARRTYPE=11 DO  QUIT
  1.  ..SET ERRTXT="Primary & alternate input formats used"
  1.  ..DO ERR
  1.  ..QUIT
  1.  .;Primary format used
  1.  .IF ARRTYPE=1 DO
  1.  ..;Copy into working array
  1.  ..SET DELIM="^"
  1.  ..SET NODE=$GET(@ARRAY@(XCPTTYPE,XCPTNUM,"RL"))
  1.  ..DO PRSENODE
  1.  ..QUIT
  1.  .;Alternate format used
  1.  .IF ARRTYPE=10 DO
  1.  ..;Copy into working array
  1.  ..KILL DATA
  1.  ..MERGE DATA=@ARRAY@(XCPTTYPE,XCPTNUM,"RL")
  1.  ..QUIT
  1.  .;Lab type code
  1.  .SET TEXT=$GET(DATA(1))
  1.  .IF (TEXT="") DO  QUIT
  1.  ..SET ERRTXT="Location Type Code of reference lab does not have a value"
  1.  ..DO ERR
  1.  ..QUIT
  1.  .IF (",1,2,3,4,5,6,"'[TEXT) DO  QUIT
  1.  ..SET ERRTXT="Location Type Code of reference lab does not have a valid value"
  1.  ..DO ERR
  1.  ..QUIT
  1.  .SET TAGREF=6.01
  1.  .DO ADD
  1.  .;Lab station number
  1.  .SET TEXT=$GET(DATA(2))
  1.  .IF (TEXT="") DO  QUIT
  1.  ..SET ERRTXT="Location Number of reference lab does not have a value"
  1.  ..DO ERR
  1.  ..QUIT
  1.  .SET TAGREF=6.02
  1.  .DO ADD
  1.  .;Lab name
  1.  .SET TEXT=$GET(DATA(3))
  1.  .IF (TEXT="") DO  QUIT
  1.  ..SET ERRTXT="Location Name of reference lab does not have a value"
  1.  ..DO ERR
  1.  ..QUIT
  1.  .SET TAGREF=6.03
  1.  .DO ADD
  1.  .;OBX-3
  1.  .SET TEXT=$GET(@ARRAY@(XCPTTYPE,XCPTNUM,"OBX",3))
  1.  .SET TAGREF=6.04
  1.  .DO ADD
  1.  .;OBX-5
  1.  .SET TEXT=$GET(@ARRAY@(XCPTTYPE,XCPTNUM,"OBX",5))
  1.  .SET TAGREF=6.05
  1.  .DO ADD
  1.  .;Summary text
  1.  .IF (SUMTXT'="") DO SUMRFLAB^HDISVAP3(SUMTXT,.DATA,.SUMNODE)
  1.  .QUIT
  1.  ;Doesn't apply to exception type - send empty elements
  1.  IF (XCPTTYPE'=2) DO
  1.  .SET TEXT=""
  1.  .FOR TAGREF=6.01:.01:6.05 DO ADD
  1.  .QUIT
  1.  ;Add end tag
  1.  SET TAGREF=6 DO ADDEND
  1.  QUIT
  1.  ;
  1. ADD ;Add text to XML document
  1.  NEW TAGNAME
  1.  ;Get element name
  1.  SET TAGNAME=$GET(@TAGS@(TAGREF))
  1.  IF (TAGNAME="") QUIT
  1.  ;Add text
  1.  DO ADD^HDISVAP3(TEXT,TAGNAME,XMLDOC,.XMLNODE)
  1.  QUIT
  1.  ;
  1. ADDBEG ; Add beginning tag to XML document
  1.  NEW TAGNAME
  1.  ;Get element name
  1.  SET TAGNAME=$GET(@TAGS@(TAGREF))
  1.  IF (TAGNAME="") QUIT
  1.  ;Add beginning tag
  1.  DO ADDBEG^HDISVAP3(TAGNAME,XMLDOC,.XMLNODE)
  1.  QUIT
  1.  ;
  1. ADDEND ;Add ending tag to XML document
  1.  NEW TAGNAME
  1.  ;Get element name
  1.  SET TAGNAME=$GET(@TAGS@(TAGREF))
  1.  IF (TAGNAME="") QUIT
  1.  ;Add closing tag
  1.  DO ADDEND^HDISVAP3(TAGNAME,XMLDOC,.XMLNODE)
  1.  QUIT
  1.  ;
  1. PRSENODE ;Parse delimited data in NODE into individual pieces
  1.  NEW LOOP
  1.  KILL DATA
  1.  FOR LOOP=1:1:$LENGTH(NODE,DELIM) DO
  1.  .SET DATA(LOOP)=$PIECE(NODE,DELIM,LOOP)
  1.  QUIT
  1.  ;
  1. ERR ;Error found
  1.  NEW X
  1.  ;Remove data from XML document
  1.  FOR X=ERRXML:1:XMLNODE KILL @XMLDOC@(X)
  1.  ;Remove data from summary text
  1.  IF (SUMTXT'="") DO
  1.  .FOR X=ERRSUM:1:SUMNODE KILL @SUMTXT@(X)
  1.  ;Log exception
  1.  IF ($GET(XCPTNUM)) SET @ARRAY@("ERROR",XCPTTYPE,XCPTNUM)=ERRTXT
  1.  IF ('$GET(XCPTNUM)) SET @ARRAY@("ERROR",XCPTTYPE)=ERRTXT
  1.  ;Reset insertion points
  1.  SET XMLNODE=ERRXML
  1.  SET SUMNODE=ERRSUM
  1.  ;Set error flag
  1.  SET ERROR=1
  1.  QUIT