| 1 | MAGDFCNV ;WOIFO/PMK - Read HL7 and generate DICOM ; 06/06/2005 09:14
|
|---|
| 2 | ;;3.0;IMAGING;**11,51**;26-August-2005
|
|---|
| 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 | ; This routine needs to be on both the Gateway and on the VistA HIS.
|
|---|
| 20 | ;
|
|---|
| 21 | ; The M-to-M Broker Gateway can't use $$CONSOLID^MAGBAPI since is
|
|---|
| 22 | ; doesn't have DDP.
|
|---|
| 23 | ;
|
|---|
| 24 | ; Note: The ^MAGOSFIL routine can never be on the VistA HIS.
|
|---|
| 25 | ;
|
|---|
| 26 | CONSOLID() ; check if this is a consolidated site or not
|
|---|
| 27 | ; return 0 = non-consolidated (normal) site
|
|---|
| 28 | ; return 1 = consolidated site
|
|---|
| 29 | ;
|
|---|
| 30 | ; code for the main VistA HIS
|
|---|
| 31 | Q $GET(^MAG(2006.1,"CONSOLIDATED"))="YES"
|
|---|
| 32 | ;
|
|---|
| 33 | ACQDEV(MFGR,MODEL,SITE) ; get pointer to the Acquisition Device file
|
|---|
| 34 | N ACQDEV ;--- name of acquisition device
|
|---|
| 35 | N ACQDEVP ;-- pointer to acquisition device file (#2006.04)
|
|---|
| 36 | ;
|
|---|
| 37 | S ACQDEV=$$UP^MAGDFCNV(MFGR_" ("_MODEL_")")
|
|---|
| 38 | S ACQDEVP=$O(^MAG(2006.04,"B",ACQDEV,""))
|
|---|
| 39 | I 'ACQDEVP D ; create the entry
|
|---|
| 40 | . L +^MAG(2006.04,0):1E9 ; serialize name generation code
|
|---|
| 41 | . I '$D(^MAG(2006.04,0)) S ^(0)="ACQUISITION DEVICE^2006.04^^"
|
|---|
| 42 | . S ACQDEVP=$P(^MAG(2006.04,0),"^",3)+1
|
|---|
| 43 | . S ^MAG(2006.04,ACQDEVP,0)=ACQDEV_"^"_SITE_"^" ; 3rd piece is null
|
|---|
| 44 | . S ^MAG(2006.04,"B",ACQDEV,ACQDEVP)=""
|
|---|
| 45 | . S $P(^MAG(2006.04,0),"^",3)=ACQDEVP
|
|---|
| 46 | . S $P(^MAG(2006.04,0),"^",4)=ACQDEVP
|
|---|
| 47 | . L -^MAG(2006.04,0) ; clear the serial name generation code
|
|---|
| 48 | Q ACQDEVP
|
|---|
| 49 | ;
|
|---|
| 50 | EQUIVGRP(P1,P2) ; see if two SOP Class pointers are in equivalent groups
|
|---|
| 51 | N G1,G2
|
|---|
| 52 | Q:'$G(P1) 0
|
|---|
| 53 | Q:'$G(P2) 0
|
|---|
| 54 | S G1=$P($G(^MAG(2006.532,P1,0)),"^",3) S:G1="" G1=P1
|
|---|
| 55 | S G2=$P($G(^MAG(2006.532,P2,0)),"^",3) S:G2="" G2=P2
|
|---|
| 56 | Q G1=G2
|
|---|
| 57 | ;
|
|---|
| 58 | UP(X) ; special UPPER CASE function -- removes redundant blanks as well
|
|---|
| 59 | F Q:X'[" " S $E(X,$F(X," ")-1)="" ; remove redundant blank
|
|---|
| 60 | I $E(X)=" " S $E(X)="" ; remove leading blank
|
|---|
| 61 | I $E(X,$L(X))=" " S $E(X,$L(X))="" ; remove trailing blank
|
|---|
| 62 | Q $TR(X,"abcdefghijklmnopqrstuvwxyz^|","ABCDEFGHIJKLMNOPQRSTUVWXYZ~~")
|
|---|
