MAGT7S ;WOIFO/MLH/PMK - telepathology - create HL7 message to DPS - segment build;04 May 2017 11:21 AM
 ;;3.0;IMAGING;**138,183**;Mar 19, 2002;Build 11;Sep 03, 2013
 ;; Per VHA Directive 2004-038, this routine should not be modified.
 ;; +---------------------------------------------------------------+
 ;; | Property of the US Government.                                |
 ;; | No permission to copy or redistribute this software is given. |
 ;; | Use of unreleased versions of this software requires the user |
 ;; | to execute a written test agreement with the VistA Imaging    |
 ;; | Development Office of the Department of Veterans Affairs,     |
 ;; | telephone (301) 734-0100.                                     |
 ;; | The Food and Drug Administration classifies this software as  |
 ;; | a medical device.  As such, it may not be changed in any way. |
 ;; | Modifications to this software may result in an adulterated   |
 ;; | medical device under 21CFR820, the use of which is considered |
 ;; | to be a violation of US Federal Statutes.                     |
 ;; +---------------------------------------------------------------+
 ;;
 ;
 ; Supported IA #4716 reference ^HLOAPI function calls
 ;
 Q
 ;
SEGADD(MSG,FILE,LABDATA,STATE,SEGNAME,DFN,LRDFN,LRSS,LRI,IENS,ACNUMB) ; FUNCTION - main entry point - create a segment
 I $G(SEGNAME)'?1U2NU Q "-4010`Invalid segment name (SEGNAME="_$G(SEGNAME)_")"
 N SPMDT ; specimen date
 N SEGELTS ; segment element array
 N IENSX,IX ; indices for NTE and SPM
 ;
 N ERRMSG ; Error message
 N ERRSTAT S ERRSTAT=0 ; error status - assume nothing to report
 ;
 D  ; SWITCH on segment name
 . I SEGNAME="PID" D  Q  ; get pt number and populate the PID segment
 . . D PIDPV1^MAGDHOW2(.MSG,DFN) ; P183 PMK 3/7/17
 . . Q
 . I SEGNAME="PV1" Q  ; done above in PIDPIV1^MAGDHOW2 - P183 PMK 3/7/17
 . ;
 . I SEGNAME="ORC" D  Q
 . . S ERRSTAT=$$ORCSEG^MAGT7SO(.SEGELTS,.FILE,STATE,IENS,ACNUMB) Q:ERRSTAT
 . . I '$$ADDSEG^HLOAPI(.MSG,.SEGELTS,.ERRMSG) D  Q
 . . . S ERRSTAT="-2`HLO SEGMENT INSERTION ERROR ("_ERRMSG_")"
 . . . Q
 . . Q
 . I SEGNAME="TQ1" D  Q
 . . S ERRSTAT=$$TQ1SEG^MAGT7ST(.SEGELTS,DFN) Q:ERRSTAT
 . . I '$$ADDSEG^HLOAPI(.MSG,.SEGELTS,.ERRMSG) D  Q
 . . . S ERRSTAT="-2`HLO SEGMENT INSERTION ERROR ("_ERRMSG_")"
 . . . Q
 . . Q
 . I SEGNAME="OBR" D  Q
 . . S ERRSTAT=$$OBRSEG^MAGT7SB(.SEGELTS,.FILE,LRSS,IENS,ACNUMB) Q:ERRSTAT
 . . I '$$ADDSEG^HLOAPI(.MSG,.SEGELTS,.ERRMSG) D  Q
 . . . S ERRSTAT="-2`HLO SEGMENT INSERTION ERROR ("_ERRMSG_")"
 . . . Q
 . . Q
 . I SEGNAME="NTE" D  Q
 . . S IENSX=""
 . . F  S IENSX=$O(@LABDATA@(FILE("COMMENT"),IENSX)) Q:IENSX=""  D  Q:ERRSTAT
 . . . S IX=$P(IENSX,",",1)
 . . . S ERRSTAT=$$NTESEGC^MAGT7SN(.SEGELTS,.FILE,IENSX,ACNUMB,IX) Q:ERRSTAT
 . . . I '$$ADDSEG^HLOAPI(.MSG,.SEGELTS,.ERRMSG) D  Q
 . . . . S ERRSTAT="-2`HLO SEGMENT INSERTION ERROR ("_ERRMSG_")"
 . . . . Q
 . . . Q
 . . Q
 . I SEGNAME="SPM" D  Q
 . . S IENSX=""
 . . F  S IENSX=$O(@LABDATA@(FILE("SPECIMEN"),IENSX)) Q:IENSX=""  D  Q:ERRSTAT
 . . . S IX=$P(IENSX,",",1)
 . . . S ERRSTAT=$$SPMSEG^MAGT7SS(.SEGELTS,.FILE,IENS,IENSX,ACNUMB,IX) Q:ERRSTAT
 . . . I '$$ADDSEG^HLOAPI(.MSG,.SEGELTS,.ERRMSG) D  Q
 . . . . S ERRSTAT="-2`HLO SEGMENT INSERTION ERROR ("_ERRMSG_")"
 . . . . Q
 . . . ; send ancillary specimen attributes in OBX segments
 . . . S ERRSTAT=$$SPMANC^MAGT7SSA(.MSG,.FILE,IENSX,LRSS,IX)
 . . . Q
 . . Q
 . I SEGNAME="IPC" D  Q
 . . S ERRSTAT=$$IPCSEG^MAGT7SI(.SEGELTS,DFN,ACNUMB) Q:ERRSTAT
 . . I '$$ADDSEG^HLOAPI(.MSG,.SEGELTS,.ERRMSG) D  Q
 . . . S ERRSTAT="-2`HLO SEGMENT INSERTION ERROR ("_ERRMSG_")"
 . . . Q
 . . Q
 . I SEGNAME="TXT" D  Q  ; output text objects as NTE segments
 . . N SS3,TITLE
 . . I 'ERRSTAT S TITLE="BRIEF CLINICAL HISTORY",SS3=.013 S ERRSTAT=$$BUILD(.SEGELTS,.FILE,IENS,TITLE,SS3) Q:ERRSTAT
 . . I 'ERRSTAT S TITLE="PREOPERATIVE DIAGNOSIS",SS3=.014 S ERRSTAT=$$BUILD(.SEGELTS,.FILE,IENS,TITLE,SS3) Q:ERRSTAT
 . . I 'ERRSTAT S TITLE="OPERATIVE FINDINGS",SS3=.015 S ERRSTAT=$$BUILD(.SEGELTS,.FILE,IENS,TITLE,SS3) Q:ERRSTAT
 . . I 'ERRSTAT S TITLE="POSTOPERATIVE FINDINGS",SS3=.016 S ERRSTAT=$$BUILD(.SEGELTS,.FILE,IENS,TITLE,SS3) Q:ERRSTAT
 . . I 'ERRSTAT S TITLE="GROSS DESCRIPTION",SS3=1 S ERRSTAT=$$BUILD(.SEGELTS,.FILE,IENS,TITLE,SS3) Q:ERRSTAT
 . . I 'ERRSTAT S TITLE="MICROSCOPIC DESCRIPTION",SS3=1.1 S ERRSTAT=$$BUILD(.SEGELTS,.FILE,IENS,TITLE,SS3) Q:ERRSTAT
 . . I 'ERRSTAT S TITLE="DIAGNOSIS",SS3=1.4 S ERRSTAT=$$BUILD(.SEGELTS,.FILE,IENS,TITLE,SS3) Q:ERRSTAT
 . . Q
 . S ERRSTAT="-3`unrecognized segment name ("_SEGNAME_")"
 . Q
 Q ERRSTAT
 ;
BUILD(SEGELTS,FILE,IENS,TITLE,SS3) ; output an NTE segment for each line of the result
 N ERRSTAT S ERRSTAT=0 ; error status - assume nothing to report
 N I,FIRST,TEXT
 S I="",FIRST=1
 F  S I=$O(@LABDATA@(FILE(0),IENS,SS3,I)) Q:'I  D  Q:ERRSTAT
 . I FIRST D  S FIRST=0
 . . S TEXT="" S ERRSTAT=$$BUILD1(.SEGELTS,TEXT) Q:ERRSTAT
 . . S TEXT=TITLE S ERRSTAT=$$BUILD1(.SEGELTS,TEXT) Q:ERRSTAT
 . . S TEXT=$TR($J("",$L(TITLE))," ","-") S ERRSTAT=$$BUILD1(.SEGELTS,TEXT) Q:ERRSTAT
 . S TEXT=@LABDATA@(FILE(0),IENS,SS3,I) S ERRSTAT=$$BUILD1(.SEGELTS,TEXT) Q:ERRSTAT
 . Q
 Q ERRSTAT
 ;
BUILD1(SEGELTS,TEXT) ; output one NTE segment
 N ERRSTAT S ERRSTAT=0 ; error status - assume nothing to report
 D
 . S ERRSTAT=$$NTESEGT^MAGT7SN(.SEGELTS,TEXT) Q:ERRSTAT
 . I '$$ADDSEG^HLOAPI(.MSG,.SEGELTS,.ERRMSG) D  Q
 . . S ERRSTAT="-2`HLO SEGMENT INSERTION ERROR ("_ERRMSG_")"
 . . Q
 . Q
 Q ERRSTAT
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGT7S   5556     printed  Sep 23, 2025@19:44:45                                                                                                                                                                                                      Page 2
MAGT7S    ;WOIFO/MLH/PMK - telepathology - create HL7 message to DPS - segment build;04 May 2017 11:21 AM
 +1       ;;3.0;IMAGING;**138,183**;Mar 19, 2002;Build 11;Sep 03, 2013
 +2       ;; Per VHA Directive 2004-038, this routine should not be modified.
 +3       ;; +---------------------------------------------------------------+
 +4       ;; | Property of the US Government.                                |
 +5       ;; | No permission to copy or redistribute this software is given. |
 +6       ;; | Use of unreleased versions of this software requires the user |
 +7       ;; | to execute a written test agreement with the VistA Imaging    |
 +8       ;; | Development Office of the Department of Veterans Affairs,     |
 +9       ;; | telephone (301) 734-0100.                                     |
 +10      ;; | The Food and Drug Administration classifies this software as  |
 +11      ;; | a medical device.  As such, it may not be changed in any way. |
 +12      ;; | Modifications to this software may result in an adulterated   |
 +13      ;; | medical device under 21CFR820, the use of which is considered |
 +14      ;; | to be a violation of US Federal Statutes.                     |
 +15      ;; +---------------------------------------------------------------+
 +16      ;;
 +17      ;
 +18      ; Supported IA #4716 reference ^HLOAPI function calls
 +19      ;
 +20       QUIT 
 +21      ;
SEGADD(MSG,FILE,LABDATA,STATE,SEGNAME,DFN,LRDFN,LRSS,LRI,IENS,ACNUMB) ; FUNCTION - main entry point - create a segment
 +1        IF $GET(SEGNAME)'?1U2NU
               QUIT "-4010`Invalid segment name (SEGNAME="_$GET(SEGNAME)_")"
 +2       ; specimen date
           NEW SPMDT
 +3       ; segment element array
           NEW SEGELTS
 +4       ; indices for NTE and SPM
           NEW IENSX,IX
 +5       ;
 +6       ; Error message
           NEW ERRMSG
 +7       ; error status - assume nothing to report
           NEW ERRSTAT
           SET ERRSTAT=0
 +8       ;
 +9       ; SWITCH on segment name
           Begin DoDot:1
 +10      ; get pt number and populate the PID segment
               IF SEGNAME="PID"
                   Begin DoDot:2
 +11      ; P183 PMK 3/7/17
                       DO PIDPV1^MAGDHOW2(.MSG,DFN)
 +12                   QUIT 
                   End DoDot:2
                   QUIT 
 +13      ; done above in PIDPIV1^MAGDHOW2 - P183 PMK 3/7/17
               IF SEGNAME="PV1"
                   QUIT 
 +14      ;
 +15           IF SEGNAME="ORC"
                   Begin DoDot:2
 +16                   SET ERRSTAT=$$ORCSEG^MAGT7SO(.SEGELTS,.FILE,STATE,IENS,ACNUMB)
                       if ERRSTAT
                           QUIT 
 +17                   IF '$$ADDSEG^HLOAPI(.MSG,.SEGELTS,.ERRMSG)
                           Begin DoDot:3
 +18                           SET ERRSTAT="-2`HLO SEGMENT INSERTION ERROR ("_ERRMSG_")"
 +19                           QUIT 
                           End DoDot:3
                           QUIT 
 +20                   QUIT 
                   End DoDot:2
                   QUIT 
 +21           IF SEGNAME="TQ1"
                   Begin DoDot:2
 +22                   SET ERRSTAT=$$TQ1SEG^MAGT7ST(.SEGELTS,DFN)
                       if ERRSTAT
                           QUIT 
 +23                   IF '$$ADDSEG^HLOAPI(.MSG,.SEGELTS,.ERRMSG)
                           Begin DoDot:3
 +24                           SET ERRSTAT="-2`HLO SEGMENT INSERTION ERROR ("_ERRMSG_")"
 +25                           QUIT 
                           End DoDot:3
                           QUIT 
 +26                   QUIT 
                   End DoDot:2
                   QUIT 
 +27           IF SEGNAME="OBR"
                   Begin DoDot:2
 +28                   SET ERRSTAT=$$OBRSEG^MAGT7SB(.SEGELTS,.FILE,LRSS,IENS,ACNUMB)
                       if ERRSTAT
                           QUIT 
 +29                   IF '$$ADDSEG^HLOAPI(.MSG,.SEGELTS,.ERRMSG)
                           Begin DoDot:3
 +30                           SET ERRSTAT="-2`HLO SEGMENT INSERTION ERROR ("_ERRMSG_")"
 +31                           QUIT 
                           End DoDot:3
                           QUIT 
 +32                   QUIT 
                   End DoDot:2
                   QUIT 
 +33           IF SEGNAME="NTE"
                   Begin DoDot:2
 +34                   SET IENSX=""
 +35                   FOR 
                           SET IENSX=$ORDER(@LABDATA@(FILE("COMMENT"),IENSX))
                           if IENSX=""
                               QUIT 
                           Begin DoDot:3
 +36                           SET IX=$PIECE(IENSX,",",1)
 +37                           SET ERRSTAT=$$NTESEGC^MAGT7SN(.SEGELTS,.FILE,IENSX,ACNUMB,IX)
                               if ERRSTAT
                                   QUIT 
 +38                           IF '$$ADDSEG^HLOAPI(.MSG,.SEGELTS,.ERRMSG)
                                   Begin DoDot:4
 +39                                   SET ERRSTAT="-2`HLO SEGMENT INSERTION ERROR ("_ERRMSG_")"
 +40                                   QUIT 
                                   End DoDot:4
                                   QUIT 
 +41                           QUIT 
                           End DoDot:3
                           if ERRSTAT
                               QUIT 
 +42                   QUIT 
                   End DoDot:2
                   QUIT 
 +43           IF SEGNAME="SPM"
                   Begin DoDot:2
 +44                   SET IENSX=""
 +45                   FOR 
                           SET IENSX=$ORDER(@LABDATA@(FILE("SPECIMEN"),IENSX))
                           if IENSX=""
                               QUIT 
                           Begin DoDot:3
 +46                           SET IX=$PIECE(IENSX,",",1)
 +47                           SET ERRSTAT=$$SPMSEG^MAGT7SS(.SEGELTS,.FILE,IENS,IENSX,ACNUMB,IX)
                               if ERRSTAT
                                   QUIT 
 +48                           IF '$$ADDSEG^HLOAPI(.MSG,.SEGELTS,.ERRMSG)
                                   Begin DoDot:4
 +49                                   SET ERRSTAT="-2`HLO SEGMENT INSERTION ERROR ("_ERRMSG_")"
 +50                                   QUIT 
                                   End DoDot:4
                                   QUIT 
 +51      ; send ancillary specimen attributes in OBX segments
 +52                           SET ERRSTAT=$$SPMANC^MAGT7SSA(.MSG,.FILE,IENSX,LRSS,IX)
 +53                           QUIT 
                           End DoDot:3
                           if ERRSTAT
                               QUIT 
 +54                   QUIT 
                   End DoDot:2
                   QUIT 
 +55           IF SEGNAME="IPC"
                   Begin DoDot:2
 +56                   SET ERRSTAT=$$IPCSEG^MAGT7SI(.SEGELTS,DFN,ACNUMB)
                       if ERRSTAT
                           QUIT 
 +57                   IF '$$ADDSEG^HLOAPI(.MSG,.SEGELTS,.ERRMSG)
                           Begin DoDot:3
 +58                           SET ERRSTAT="-2`HLO SEGMENT INSERTION ERROR ("_ERRMSG_")"
 +59                           QUIT 
                           End DoDot:3
                           QUIT 
 +60                   QUIT 
                   End DoDot:2
                   QUIT 
 +61      ; output text objects as NTE segments
               IF SEGNAME="TXT"
                   Begin DoDot:2
 +62                   NEW SS3,TITLE
 +63                   IF 'ERRSTAT
                           SET TITLE="BRIEF CLINICAL HISTORY"
                           SET SS3=.013
                           SET ERRSTAT=$$BUILD(.SEGELTS,.FILE,IENS,TITLE,SS3)
                           if ERRSTAT
                               QUIT 
 +64                   IF 'ERRSTAT
                           SET TITLE="PREOPERATIVE DIAGNOSIS"
                           SET SS3=.014
                           SET ERRSTAT=$$BUILD(.SEGELTS,.FILE,IENS,TITLE,SS3)
                           if ERRSTAT
                               QUIT 
 +65                   IF 'ERRSTAT
                           SET TITLE="OPERATIVE FINDINGS"
                           SET SS3=.015
                           SET ERRSTAT=$$BUILD(.SEGELTS,.FILE,IENS,TITLE,SS3)
                           if ERRSTAT
                               QUIT 
 +66                   IF 'ERRSTAT
                           SET TITLE="POSTOPERATIVE FINDINGS"
                           SET SS3=.016
                           SET ERRSTAT=$$BUILD(.SEGELTS,.FILE,IENS,TITLE,SS3)
                           if ERRSTAT
                               QUIT 
 +67                   IF 'ERRSTAT
                           SET TITLE="GROSS DESCRIPTION"
                           SET SS3=1
                           SET ERRSTAT=$$BUILD(.SEGELTS,.FILE,IENS,TITLE,SS3)
                           if ERRSTAT
                               QUIT 
 +68                   IF 'ERRSTAT
                           SET TITLE="MICROSCOPIC DESCRIPTION"
                           SET SS3=1.1
                           SET ERRSTAT=$$BUILD(.SEGELTS,.FILE,IENS,TITLE,SS3)
                           if ERRSTAT
                               QUIT 
 +69                   IF 'ERRSTAT
                           SET TITLE="DIAGNOSIS"
                           SET SS3=1.4
                           SET ERRSTAT=$$BUILD(.SEGELTS,.FILE,IENS,TITLE,SS3)
                           if ERRSTAT
                               QUIT 
 +70                   QUIT 
                   End DoDot:2
                   QUIT 
 +71           SET ERRSTAT="-3`unrecognized segment name ("_SEGNAME_")"
 +72           QUIT 
           End DoDot:1
 +73       QUIT ERRSTAT
 +74      ;
BUILD(SEGELTS,FILE,IENS,TITLE,SS3) ; output an NTE segment for each line of the result
 +1       ; error status - assume nothing to report
           NEW ERRSTAT
           SET ERRSTAT=0
 +2        NEW I,FIRST,TEXT
 +3        SET I=""
           SET FIRST=1
 +4        FOR 
               SET I=$ORDER(@LABDATA@(FILE(0),IENS,SS3,I))
               if 'I
                   QUIT 
               Begin DoDot:1
 +5                IF FIRST
                       Begin DoDot:2
 +6                        SET TEXT=""
                           SET ERRSTAT=$$BUILD1(.SEGELTS,TEXT)
                           if ERRSTAT
                               QUIT 
 +7                        SET TEXT=TITLE
                           SET ERRSTAT=$$BUILD1(.SEGELTS,TEXT)
                           if ERRSTAT
                               QUIT 
 +8                        SET TEXT=$TRANSLATE($JUSTIFY("",$LENGTH(TITLE))," ","-")
                           SET ERRSTAT=$$BUILD1(.SEGELTS,TEXT)
                           if ERRSTAT
                               QUIT 
                       End DoDot:2
                       SET FIRST=0
 +9                SET TEXT=@LABDATA@(FILE(0),IENS,SS3,I)
                   SET ERRSTAT=$$BUILD1(.SEGELTS,TEXT)
                   if ERRSTAT
                       QUIT 
 +10               QUIT 
               End DoDot:1
               if ERRSTAT
                   QUIT 
 +11       QUIT ERRSTAT
 +12      ;
BUILD1(SEGELTS,TEXT) ; output one NTE segment
 +1       ; error status - assume nothing to report
           NEW ERRSTAT
           SET ERRSTAT=0
 +2        Begin DoDot:1
 +3            SET ERRSTAT=$$NTESEGT^MAGT7SN(.SEGELTS,TEXT)
               if ERRSTAT
                   QUIT 
 +4            IF '$$ADDSEG^HLOAPI(.MSG,.SEGELTS,.ERRMSG)
                   Begin DoDot:2
 +5                    SET ERRSTAT="-2`HLO SEGMENT INSERTION ERROR ("_ERRMSG_")"
 +6                    QUIT 
                   End DoDot:2
                   QUIT 
 +7            QUIT 
           End DoDot:1
 +8        QUIT ERRSTAT