MAGT7SB.m

MAGT7SB ;WOIFO/MLH/PMK - telepathology - create HL7 message to DPS - segment build - OBR ; 24 Jul 2013 8:23 PM

 ;;3.0;IMAGING;**138**;Mar 19, 2002;Build 5380;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.                     |

 ;; +---------------------------------------------------------------+

 ;;

 Q

 ;

OBRSEG(SEGELTS,FILE,LRSS,IENS,ACNUMB) ; FUNCTION - main entry point - create an OBR segment

 N LABTEST ; name of lab test

 N SETID S SETID=1 ; set ID value for OBR segment

 N FLDSETID S FLDSETID=1 ; set ID field number

 N FLDPLORDNO S FLDPLORDNO=2 ; placer order number field number

 N FLDUNIVSVCID S FLDUNIVSVCID=4 ; universal service ID field number

 N FLDCOLLECTOR S FLDCOLLECTOR=10 ; name of person who collected the specimen

 N FLDORDPVDR S FLDORDPVDR=16 ; ordering provider field number

 N FLDCALBKPHN S FLDCALBKPHN=17 ; call back phone number field number

 N FLDDXSERVID S FLDDXSERVID=24 ; diagnostic service section id

 N ORDPVDRNO ; ordering provider number

 N ORDPVDRNAM ; ordering provider name

 N ERRSTAT S ERRSTAT=0 ; error status - assume nothing to report

 ;

 K SEGELTS ; always refresh *segment* array (not message array) on entry

 ;

 D SET^HLOAPI(.SEGELTS,"OBR",0) ; segment type

 D  ; set up fields, check exit flag after each

 . D  Q:ERRSTAT  ; OBR-1-set ID

 . . D SET^HLOAPI(.SEGELTS,SETID,FLDSETID)

 . . Q

 . D  Q:ERRSTAT  ; OBR-2-placer order number

 . . D SET^HLOAPI(.SEGELTS,ACNUMB,FLDPLORDNO)

 . . Q

 . D  Q:ERRSTAT  ; OBR-4-universal service ID

 . . D TESTLKUP(LABDATA,.LABTEST)

 . . S LABTEST("SYSTEM")="VISTA60"

 . . D SETCE^HLOAPI4(.SEGELTS,.LABTEST,FLDUNIVSVCID)

 . . Q

 . D  Q:ERRSTAT  ; OBR-10-collector ID

 . . N COLLECTOR ; person who collected the specimen

 . . ; the data type of this field is XCN (extended composite name)

 . . ; unfortunately, the lab package only records it as free text,

 . . ; so it is output in sequence 2 as "Family Name"

 . . S COLLECTOR=$G(@LABDATA@(FILE("0"),IENS,.011,"I"))

 . . D SET^HLOAPI(.SEGELTS,COLLECTOR,FLDCOLLECTOR,2)

 . . Q

 . D  Q:ERRSTAT  ; OBR-16-ordering provider

 . . S ORDPVDRNO=$$GET1^DIQ(FILE(0),IENS,.07,"I")

 . . I 'ORDPVDRNO D SET^HLOAPI(.SEGELTS,"""""",FLDORDPVDR,1) Q  ; no ordering provider

 . . S ERRSTAT=$$NPNAME^MAG7UNM(.ORDPVDRNAM,ORDPVDRNO)

 . . D:'ERRSTAT

 . . . D SET^HLOAPI(.SEGELTS,ORDPVDRNO,FLDORDPVDR,1)

 . . . D SET^HLOAPI(.SEGELTS,$G(ORDPVDRNAM("FAMILY"),""),FLDORDPVDR,2)

 . . . D SET^HLOAPI(.SEGELTS,$G(ORDPVDRNAM("GIVEN"),""),FLDORDPVDR,3)

 . . . D SET^HLOAPI(.SEGELTS,$G(ORDPVDRNAM("MIDDLE"),""),FLDORDPVDR,4)

 . . . Q

 . . Q

 . D  Q:ERRSTAT  ; OBR-17-call back phone number

 . . S ERRSTAT=$$CALLBACK^MAGT7SO(.SEGELTS,ORDPVDRNO,FLDCALBKPHN)

 . . Q

 . D  Q:ERRSTAT  ; OBR-24-diagnostic service section id

 . . N ID

 . . S ID=$P(ACNUMB," ",1) ; VA lab service from file #62.2

 . . ; Note that for cytology (cytopathology) the abbreviation should be CP and not CY

 . . ; We are ignoring that difference because it makes it more complicated for the worklist

 . . ; S ID=$S(ID="CY":"CP",1:ID) ; see HL7 2.5.1 Ch 4 section 4.5.3.24

 . . D SET^HLOAPI(.SEGELTS,ID,FLDDXSERVID)

 . . Q

 . Q

 ;

 Q ERRSTAT

 ;

TESTLKUP(LABDATA,LABTEST) ; lookup the test - called by MAGVIM02 as well

 N IENS

 S IENS=$O(@LABDATA@(FILE("ORDERED TEST"),""))

 I IENS'="" D

 . S LABTEST=$G(@LABDATA@(FILE("ORDERED TEST"),IENS,13,"I"))

 . I LABTEST D

 . . S LABTEST("ID")=LABTEST

 . . S LABTEST("TEXT")=$$GET1^DIQ(60,LABTEST,.01,"E")

 . . Q

 . Q

 I '$D(LABTEST("ID")) D  ; use default test

 . S LABTEST("ID")=FILE("PROCEDURE IEN")

 . S LABTEST("TEXT")=FILE("PROCEDURE NAME")

 . Q

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---MAGT7SB   4510     printed  Feb 18, 2025@23:34:57                                                                                                                                                                                                     Page 2

MAGT7SB   ;WOIFO/MLH/PMK - telepathology - create HL7 message to DPS - segment build - OBR ; 24 Jul 2013 8:23 PM

 +1       ;;3.0;IMAGING;**138**;Mar 19, 2002;Build 5380;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       QUIT 

 +18      ;

OBRSEG(SEGELTS,FILE,LRSS,IENS,ACNUMB) ; FUNCTION - main entry point - create an OBR segment

 +1       ; name of lab test

           NEW LABTEST

 +2       ; set ID value for OBR segment

           NEW SETID

           SET SETID=1

 +3       ; set ID field number

           NEW FLDSETID

           SET FLDSETID=1

 +4       ; placer order number field number

           NEW FLDPLORDNO

           SET FLDPLORDNO=2

 +5       ; universal service ID field number

           NEW FLDUNIVSVCID

           SET FLDUNIVSVCID=4

 +6       ; name of person who collected the specimen

           NEW FLDCOLLECTOR

           SET FLDCOLLECTOR=10

 +7       ; ordering provider field number

           NEW FLDORDPVDR

           SET FLDORDPVDR=16

 +8       ; call back phone number field number

           NEW FLDCALBKPHN

           SET FLDCALBKPHN=17

 +9       ; diagnostic service section id

           NEW FLDDXSERVID

           SET FLDDXSERVID=24

 +10      ; ordering provider number

           NEW ORDPVDRNO

 +11      ; ordering provider name

           NEW ORDPVDRNAM

 +12      ; error status - assume nothing to report

           NEW ERRSTAT

           SET ERRSTAT=0

 +13      ;

 +14      ; always refresh *segment* array (not message array) on entry

           KILL SEGELTS

 +15      ;

 +16      ; segment type

           DO SET^HLOAPI(.SEGELTS,"OBR",0)

 +17      ; set up fields, check exit flag after each

           Begin DoDot:1

 +18      ; OBR-1-set ID

               Begin DoDot:2

 +19               DO SET^HLOAPI(.SEGELTS,SETID,FLDSETID)

 +20               QUIT 

               End DoDot:2

               if ERRSTAT

                   QUIT 

 +21      ; OBR-2-placer order number

               Begin DoDot:2

 +22               DO SET^HLOAPI(.SEGELTS,ACNUMB,FLDPLORDNO)

 +23               QUIT 

               End DoDot:2

               if ERRSTAT

                   QUIT 

 +24      ; OBR-4-universal service ID

               Begin DoDot:2

 +25               DO TESTLKUP(LABDATA,.LABTEST)

 +26               SET LABTEST("SYSTEM")="VISTA60"

 +27               DO SETCE^HLOAPI4(.SEGELTS,.LABTEST,FLDUNIVSVCID)

 +28               QUIT 

               End DoDot:2

               if ERRSTAT

                   QUIT 

 +29      ; OBR-10-collector ID

               Begin DoDot:2

 +30      ; person who collected the specimen

                   NEW COLLECTOR

 +31      ; the data type of this field is XCN (extended composite name)

 +32      ; unfortunately, the lab package only records it as free text,

 +33      ; so it is output in sequence 2 as "Family Name"

 +34               SET COLLECTOR=$GET(@LABDATA@(FILE("0"),IENS,.011,"I"))

 +35               DO SET^HLOAPI(.SEGELTS,COLLECTOR,FLDCOLLECTOR,2)

 +36               QUIT 

               End DoDot:2

               if ERRSTAT

                   QUIT 

 +37      ; OBR-16-ordering provider

               Begin DoDot:2

 +38               SET ORDPVDRNO=$$GET1^DIQ(FILE(0),IENS,.07,"I")

 +39      ; no ordering provider

                   IF 'ORDPVDRNO

                       DO SET^HLOAPI(.SEGELTS,"""""",FLDORDPVDR,1)

                       QUIT 

 +40               SET ERRSTAT=$$NPNAME^MAG7UNM(.ORDPVDRNAM,ORDPVDRNO)

 +41               if 'ERRSTAT

                       Begin DoDot:3

 +42                       DO SET^HLOAPI(.SEGELTS,ORDPVDRNO,FLDORDPVDR,1)

 +43                       DO SET^HLOAPI(.SEGELTS,$GET(ORDPVDRNAM("FAMILY"),""),FLDORDPVDR,2)

 +44                       DO SET^HLOAPI(.SEGELTS,$GET(ORDPVDRNAM("GIVEN"),""),FLDORDPVDR,3)

 +45                       DO SET^HLOAPI(.SEGELTS,$GET(ORDPVDRNAM("MIDDLE"),""),FLDORDPVDR,4)

 +46                       QUIT 

                       End DoDot:3

 +47               QUIT 

               End DoDot:2

               if ERRSTAT

                   QUIT 

 +48      ; OBR-17-call back phone number

               Begin DoDot:2

 +49               SET ERRSTAT=$$CALLBACK^MAGT7SO(.SEGELTS,ORDPVDRNO,FLDCALBKPHN)

 +50               QUIT 

               End DoDot:2

               if ERRSTAT

                   QUIT 

 +51      ; OBR-24-diagnostic service section id

               Begin DoDot:2

 +52               NEW ID

 +53      ; VA lab service from file #62.2

                   SET ID=$PIECE(ACNUMB," ",1)

 +54      ; Note that for cytology (cytopathology) the abbreviation should be CP and not CY

 +55      ; We are ignoring that difference because it makes it more complicated for the worklist

 +56      ; S ID=$S(ID="CY":"CP",1:ID) ; see HL7 2.5.1 Ch 4 section 4.5.3.24

 +57               DO SET^HLOAPI(.SEGELTS,ID,FLDDXSERVID)

 +58               QUIT 

               End DoDot:2

               if ERRSTAT

                   QUIT 

 +59           QUIT 

           End DoDot:1

 +60      ;

 +61       QUIT ERRSTAT

 +62      ;

TESTLKUP(LABDATA,LABTEST) ; lookup the test - called by MAGVIM02 as well

 +1        NEW IENS

 +2        SET IENS=$ORDER(@LABDATA@(FILE("ORDERED TEST"),""))

 +3        IF IENS'=""

               Begin DoDot:1

 +4                SET LABTEST=$GET(@LABDATA@(FILE("ORDERED TEST"),IENS,13,"I"))

 +5                IF LABTEST

                       Begin DoDot:2

 +6                        SET LABTEST("ID")=LABTEST

 +7                        SET LABTEST("TEXT")=$$GET1^DIQ(60,LABTEST,.01,"E")

 +8                        QUIT 

                       End DoDot:2

 +9                QUIT 

               End DoDot:1

 +10      ; use default test

           IF '$DATA(LABTEST("ID"))

               Begin DoDot:1

 +11               SET LABTEST("ID")=FILE("PROCEDURE IEN")

 +12               SET LABTEST("TEXT")=FILE("PROCEDURE NAME")

 +13               QUIT 

               End DoDot:1

 +14       QUIT