source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGDMEDK.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 2.0 KB
Line 
1MAGDMEDK ;WOIFO/LB Routine to find Medicine subspecialty [ 06/20/2001 08:56 ] ; 06/06/2005 09:25
2 ;;3.0;IMAGING;**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 Q
19SUB(MAGSUB,MAGPAT) ;Get Medicine subspecialty and entries.
20 ; an array should be produced and only for entries found from call to
21 ; api SUB^MCARUTL2:
22 ; MAGMC(#)=data formatted from call to SUB^MCARUTL2
23 Q:'$D(MAGPAT)!'$D(MAGSUB)
24 N I,II,X,Y,MAGMC,MAGXX,SUB
25 S MAGMC(0)="0^0"
26 D SUB^MCARUTL2(.MAGXX,MAGPAT,MAGSUB)
27 Q:'MAGXX
28 S I=0 F S I=$O(MAGXX(I)) Q:'I D
29 . S (X,Y)="",X=$P(MAGXX(I),"^"),%DT="ST" D ^%DT
30 . S MAGMC(MAGPAT,SUB,Y,I)=$G(MAGXX(I))
31 . I $D(MAGXX(I,2005)) S II=0 D
32 . . F S II=$O(MAGXX(I,2005,II)) Q:'II D
33 . . . S MAGMC(MAGPAT,SUB,Y,I,2005,II)=MAGXX(I,2005,II)
34 S MAGMC(0)="1^"_$G(MAGXX(0))
35 Q
36PATSUB(MAGSUB1,MAGDFN) ;
37 Q:'MAGDFN
38 N I,MAGX
39 D PATSUB^MCARUTL2(.MAGX,MAGDFN)
40 Q:'MAGX
41 Q:'$D(MAGX(0))
42 S MAGSUB1(0)="1^"_+MAGX_"^"_$P(MAGX(0),"^",2)
43 ; MAGSUB1(0)=1^#entries^msg text
44 S I=0 F S I=$O(MAGX(I)) Q:'I D
45 . S MAGSUB1(I)=$P(MAGX(I),"^")_" ("_$P(MAGX(I),"^",2)_")"
46 . ; MAGSUB1(#)=OPH (25) --25 being ien for procedure
47 Q
Note: See TracBrowser for help on using the repository browser.