source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAG7RSR.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1MAG7RSR ;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 ;
19ROLADD(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
Note: See TracBrowser for help on using the repository browser.