MAGT7SS ;WOIFO/MLH/PMK - telepathology - create HL7 message to DPS - segment build - SPM ; 17 Jul 2013 12:07 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
;
SPMSEG(SEGELTS,FILE,IENS,IENSX,ACNUMB,IX) ; FUNCTION - main entry point - create an SPM segment
N SPCID ; specimen ID = accession number + specimen number (IX)
N SPCDESC ; specimen description
N SPCTYPEE,SPCTYPEI ; specimen type - topography
N TIMESTAMP ; date/time for specimen collection/received events
N FLDSETID S FLDSETID=1 ; set ID field number in SPM segment
N FLDSPCID S FLDSPCID=2 ; specimen ID field number
N FLDSPTYPE S FLDSPTYPE=4 ; specimen type
N FLDSPCDESC S FLDSPCDESC=14 ; specimen description
N FLDSPCCLTDT S FLDSPCCLTDT=17 ; specimen collection date/time
N FLDSPCRCVDT S FLDSPCRCVDT=18 ; specimen received date/time
N FLDSPCCOUNT S FLDSPCCOUNT=26 ; number of specimen containers
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,"SPM",0) ; segment type
D ; set up fields, check exit flag after each
. D Q:ERRSTAT ; SPM-1-set ID
. . S SETID=$G(SETID("SPM"))+1,SETID("SPM")=SETID
. . D SET^HLOAPI(.SEGELTS,SETID,FLDSETID)
. . Q
. D Q:ERRSTAT ; SPM-2-specimen ID
. . N UID
. . S SPCID=ACNUMB_" "_IX
. . S UID=$$UID^MAGT7SI(DFN,ACNUMB,"SPECIMEN",IX)
. . D SET^HLOAPI(.SEGELTS,SPCID,FLDSPCID,1) ; subcomponent #1 - entity identifier
. . D SET^HLOAPI(.SEGELTS,$S($$ISIHS^MAGSPID():"USIHS",1:"USVHA"),FLDSPCID,2) ; subcomponent #2 - namespace id
. . D SET^HLOAPI(.SEGELTS,UID,FLDSPCID,3) ; subcomponent #3 - UID
. . Q
. D Q:ERRSTAT ; SPM-4-specimen type
. . S SPCTYPEI=$G(@LABDATA@(FILE("SPECIMEN"),IENSX,.06,"I"))
. . S SPCTYPEE="" I SPCTYPEI S SPCTYPEE=$$GET1^DIQ(61,SPCTYPEI,.01)
. . D SET^HLOAPI(.SEGELTS,SPCTYPEI,FLDSPTYPE,1) ; subcomponent #1 - identifier
. . D SET^HLOAPI(.SEGELTS,SPCTYPEE,FLDSPTYPE,2) ; subcomponent #2 - text
. . D SET^HLOAPI(.SEGELTS,"VISTA61",FLDSPTYPE,3) ; subcomponent #3 - name of coding system
. . Q
. D Q:ERRSTAT ; SPM-14-specimen description
. . S SPCDESC=$G(@LABDATA@(FILE("SPECIMEN"),IENSX,.01,"I"))
. . D:SPCDESC'="" SET^HLOAPI(.SEGELTS,SPCDESC,FLDSPCDESC)
. . Q
. D Q:ERRSTAT ; SPM-17-specimen collection date/time
. . S TIMESTAMP=$G(@LABDATA@(FILE(0),IENS,.01,"I"))
. . D:TIMESTAMP SETTS^HLOAPI4(.SEGELTS,TIMESTAMP,FLDSPCCLTDT)
. . Q
. D Q:ERRSTAT ; SPM-18-specimen received date/time of transaction
. . S TIMESTAMP=$G(@LABDATA@(FILE(0),IENS,.1,"I"))
. . D:TIMESTAMP SETTS^HLOAPI4(.SEGELTS,TIMESTAMP,FLDSPCRCVDT)
. . Q
. D Q:ERRSTAT ; SPM-26-Number of specimen containers
. . N COUNT
. . S COUNT=$$COUNT^MAGT7SS(.FILE,IENSX)
. . D SET^HLOAPI(.SEGELTS,COUNT,FLDSPCCOUNT)
. . Q
. Q
Q ERRSTAT
;
COUNT(FILE,IENSX) ; return the number of specimen containers (slides or sections)
N BLOCKNAME ; name of block in LAB DATA file (#63)
N COUNT ; count of number of specimen containers
N STAINFILE ; Fileman file number for stain
N STAINNAME ; name of stain
N STAINSS2 ; ss2 in LABDATA for stain
;
; count the number of slides/sections prepared for each block for each stain
;
S COUNT=0
S BLOCKNAME=""
F S BLOCKNAME=$O(FILE("SPECIMEN",BLOCKNAME)) Q:BLOCKNAME="" D
. S STAINNAME=""
. F S STAINNAME=$O(FILE("SPECIMEN",BLOCKNAME,STAINNAME)) Q:STAINNAME="" D
. . S STAINFILE=FILE("SPECIMEN",BLOCKNAME,STAINNAME)
. . S STAINSS2=""
. . F S STAINSS2=$O(@LABDATA@(STAINFILE,STAINSS2)) Q:STAINSS2="" D
. . . I $P(STAINSS2,",",3,999)=IENSX D ; got this specimen
. . . . S COUNT=COUNT+$G(@LABDATA@(STAINFILE,STAINSS2,.02,"I"))
. . . . Q
. . . Q
. . Q
. Q
Q COUNT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGT7SS 4766 printed Sep 23, 2025@19:44:50 Page 2
MAGT7SS ;WOIFO/MLH/PMK - telepathology - create HL7 message to DPS - segment build - SPM ; 17 Jul 2013 12:07 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 ;
SPMSEG(SEGELTS,FILE,IENS,IENSX,ACNUMB,IX) ; FUNCTION - main entry point - create an SPM segment
+1 ; specimen ID = accession number + specimen number (IX)
NEW SPCID
+2 ; specimen description
NEW SPCDESC
+3 ; specimen type - topography
NEW SPCTYPEE,SPCTYPEI
+4 ; date/time for specimen collection/received events
NEW TIMESTAMP
+5 ; set ID field number in SPM segment
NEW FLDSETID
SET FLDSETID=1
+6 ; specimen ID field number
NEW FLDSPCID
SET FLDSPCID=2
+7 ; specimen type
NEW FLDSPTYPE
SET FLDSPTYPE=4
+8 ; specimen description
NEW FLDSPCDESC
SET FLDSPCDESC=14
+9 ; specimen collection date/time
NEW FLDSPCCLTDT
SET FLDSPCCLTDT=17
+10 ; specimen received date/time
NEW FLDSPCRCVDT
SET FLDSPCRCVDT=18
+11 ; number of specimen containers
NEW FLDSPCCOUNT
SET FLDSPCCOUNT=26
+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,"SPM",0)
+17 ; set up fields, check exit flag after each
Begin DoDot:1
+18 ; SPM-1-set ID
Begin DoDot:2
+19 SET SETID=$GET(SETID("SPM"))+1
SET SETID("SPM")=SETID
+20 DO SET^HLOAPI(.SEGELTS,SETID,FLDSETID)
+21 QUIT
End DoDot:2
if ERRSTAT
QUIT
+22 ; SPM-2-specimen ID
Begin DoDot:2
+23 NEW UID
+24 SET SPCID=ACNUMB_" "_IX
+25 SET UID=$$UID^MAGT7SI(DFN,ACNUMB,"SPECIMEN",IX)
+26 ; subcomponent #1 - entity identifier
DO SET^HLOAPI(.SEGELTS,SPCID,FLDSPCID,1)
+27 ; subcomponent #2 - namespace id
DO SET^HLOAPI(.SEGELTS,$SELECT($$ISIHS^MAGSPID():"USIHS",1:"USVHA"),FLDSPCID,2)
+28 ; subcomponent #3 - UID
DO SET^HLOAPI(.SEGELTS,UID,FLDSPCID,3)
+29 QUIT
End DoDot:2
if ERRSTAT
QUIT
+30 ; SPM-4-specimen type
Begin DoDot:2
+31 SET SPCTYPEI=$GET(@LABDATA@(FILE("SPECIMEN"),IENSX,.06,"I"))
+32 SET SPCTYPEE=""
IF SPCTYPEI
SET SPCTYPEE=$$GET1^DIQ(61,SPCTYPEI,.01)
+33 ; subcomponent #1 - identifier
DO SET^HLOAPI(.SEGELTS,SPCTYPEI,FLDSPTYPE,1)
+34 ; subcomponent #2 - text
DO SET^HLOAPI(.SEGELTS,SPCTYPEE,FLDSPTYPE,2)
+35 ; subcomponent #3 - name of coding system
DO SET^HLOAPI(.SEGELTS,"VISTA61",FLDSPTYPE,3)
+36 QUIT
End DoDot:2
if ERRSTAT
QUIT
+37 ; SPM-14-specimen description
Begin DoDot:2
+38 SET SPCDESC=$GET(@LABDATA@(FILE("SPECIMEN"),IENSX,.01,"I"))
+39 if SPCDESC'=""
DO SET^HLOAPI(.SEGELTS,SPCDESC,FLDSPCDESC)
+40 QUIT
End DoDot:2
if ERRSTAT
QUIT
+41 ; SPM-17-specimen collection date/time
Begin DoDot:2
+42 SET TIMESTAMP=$GET(@LABDATA@(FILE(0),IENS,.01,"I"))
+43 if TIMESTAMP
DO SETTS^HLOAPI4(.SEGELTS,TIMESTAMP,FLDSPCCLTDT)
+44 QUIT
End DoDot:2
if ERRSTAT
QUIT
+45 ; SPM-18-specimen received date/time of transaction
Begin DoDot:2
+46 SET TIMESTAMP=$GET(@LABDATA@(FILE(0),IENS,.1,"I"))
+47 if TIMESTAMP
DO SETTS^HLOAPI4(.SEGELTS,TIMESTAMP,FLDSPCRCVDT)
+48 QUIT
End DoDot:2
if ERRSTAT
QUIT
+49 ; SPM-26-Number of specimen containers
Begin DoDot:2
+50 NEW COUNT
+51 SET COUNT=$$COUNT^MAGT7SS(.FILE,IENSX)
+52 DO SET^HLOAPI(.SEGELTS,COUNT,FLDSPCCOUNT)
+53 QUIT
End DoDot:2
if ERRSTAT
QUIT
+54 QUIT
End DoDot:1
+55 QUIT ERRSTAT
+56 ;
COUNT(FILE,IENSX) ; return the number of specimen containers (slides or sections)
+1 ; name of block in LAB DATA file (#63)
NEW BLOCKNAME
+2 ; count of number of specimen containers
NEW COUNT
+3 ; Fileman file number for stain
NEW STAINFILE
+4 ; name of stain
NEW STAINNAME
+5 ; ss2 in LABDATA for stain
NEW STAINSS2
+6 ;
+7 ; count the number of slides/sections prepared for each block for each stain
+8 ;
+9 SET COUNT=0
+10 SET BLOCKNAME=""
+11 FOR
SET BLOCKNAME=$ORDER(FILE("SPECIMEN",BLOCKNAME))
if BLOCKNAME=""
QUIT
Begin DoDot:1
+12 SET STAINNAME=""
+13 FOR
SET STAINNAME=$ORDER(FILE("SPECIMEN",BLOCKNAME,STAINNAME))
if STAINNAME=""
QUIT
Begin DoDot:2
+14 SET STAINFILE=FILE("SPECIMEN",BLOCKNAME,STAINNAME)
+15 SET STAINSS2=""
+16 FOR
SET STAINSS2=$ORDER(@LABDATA@(STAINFILE,STAINSS2))
if STAINSS2=""
QUIT
Begin DoDot:3
+17 ; got this specimen
IF $PIECE(STAINSS2,",",3,999)=IENSX
Begin DoDot:4
+18 SET COUNT=COUNT+$GET(@LABDATA@(STAINFILE,STAINSS2,.02,"I"))
+19 QUIT
End DoDot:4
+20 QUIT
End DoDot:3
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
+23 QUIT COUNT
