| [613] | 1 | MAG7RSR ;WOIFO/PMK,MLH - copy radiology message from HLSDATA to ^MAGDHL7 - add ROL segment data ; 18 Dec 2003 3:56 PM
|
|---|
| 2 | ;;3.0;IMAGING;**11**;14-April-2004
|
|---|
| 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 | ;; | |
|
|---|
| 11 | ;; | The Food and Drug Administration classifies this software as |
|
|---|
| 12 | ;; | a medical device. As such, it may not be changed in any way. |
|
|---|
| 13 | ;; | Modifications to this software may result in an adulterated |
|
|---|
| 14 | ;; | medical device under 21CFR820, the use of which is considered |
|
|---|
| 15 | ;; | to be a violation of US Federal Statutes. |
|
|---|
| 16 | ;; +---------------------------------------------------------------+
|
|---|
| 17 | ;;
|
|---|
| 18 | ;
|
|---|
| 19 | ROLADD(XPHY,XROL) ; SUBROUTINE - called by PV1ADD
|
|---|
| 20 | ; Add role information for the attending or referring physician
|
|---|
| 21 | ; to the ADT message.
|
|---|
| 22 | ;
|
|---|
| 23 | ; Expects: MAG7WRK() HL7 message array
|
|---|
| 24 | ;
|
|---|
| 25 | ; Input: XPHY() array containing PV1 info for attending or
|
|---|
| 26 | ; referring DR
|
|---|
| 27 | ; XROL the role being populated:
|
|---|
| 28 | ; AT = attending, RP = referring
|
|---|
| 29 | ;
|
|---|
| 30 | N IXROL ; ---------- role segment index
|
|---|
| 31 | N IXSEG ; ---------- segment index
|
|---|
| 32 | N IXPRED,IXSUCC ; -- indices to segments to be inserted between
|
|---|
| 33 | N RLINSTID ; ------- role instance ID
|
|---|
| 34 | N FPHN ; ----------- phone number fetch flag (discarded)
|
|---|
| 35 | ;
|
|---|
| 36 | ; already a ROL segment on file?
|
|---|
| 37 | I $D(MAG7WRK("B","ROL")) D ; yes, add another one
|
|---|
| 38 | . S (IXSEG,IXPRED)=$O(MAG7WRK("B","ROL"," "),-1)
|
|---|
| 39 | . S RLINSTID=MAG7WRK(IXSEG,1,1,1,1)
|
|---|
| 40 | . Q
|
|---|
| 41 | E D ; no, add the first one
|
|---|
| 42 | . S (IXSEG,IXPRED)=$O(MAG7WRK("B","PV1","")) Q:'IXSEG
|
|---|
| 43 | . F S IXSEG=$O(MAG7WRK(IXSEG)) Q:'IXSEG Q:"^PV1^PV2^ROL^"'[("^"_$G(MAG7WRK(IXSEG,0))_"^") S IXPRED=IXSEG
|
|---|
| 44 | . S RLINSTID=0
|
|---|
| 45 | . Q
|
|---|
| 46 | ; now compute the index of the ROL segment, and fill in
|
|---|
| 47 | S IXSUCC=$O(MAG7WRK(IXPRED)),IXROL=$S(IXSUCC:IXPRED+IXSUCC/2,1:IXPRED+1)
|
|---|
| 48 | S MAG7WRK(IXROL,0)="ROL",MAG7WRK("B","ROL",IXROL)=""
|
|---|
| 49 | S MAG7WRK(IXROL,1,1,1,1)=RLINSTID+1 ; instance ID always begins at 1
|
|---|
| 50 | S MAG7WRK(IXROL,2,1,1,1)="UC" ; unchanged
|
|---|
| 51 | S MAG7WRK(IXROL,3,1,1,1)=XROL
|
|---|
| 52 | M MAG7WRK(IXROL,4,1)=@XPHY
|
|---|
| 53 | S FPHN=$$NPFON^MAG7UFO($NA(MAG7WRK(IXROL,12)),MAG7WRK(IXROL,4,1,1,1))
|
|---|
| 54 | Q
|
|---|
