source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTMC.m@ 619

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

initial load of WorldVistAEHR
File size: 3.8 KB
Line 
1MAGGTMC ;WOIFO/GEK - RPC Calls for Imaging/Medicine procedures ; [ 06/20/2001 08:56 ]
2 ;;3.0;IMAGING;**8**;Sep 15, 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 Q
19LIST(MAGRY,MAGGZY) ;RPC [MAGGLISTPROC]
20 ; Call to return a list of procedures/subspecialities
21 ;MAGGZY NOT USED in Version 2.5
22 ; if MAGGZY=1 then add procedure PRINT NAME (full name) in output
23 ; returns list of NAME PRINT NAME ^ GLOBAL ^ IEN
24 ; i.e. "ECG ELECTROCARDIOGRAM^MCAR(691.5^2"
25 IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
26 E S X="ERRA^MAGGTERR",@^%ZOSF("TRAP")
27 N X,Y,Z,I,CT,PRCSTR,MAGKEY,TEMP,MAGPLC
28 S CT=0
29 ; Now we will check keys for medicine procedures the user is
30 ; allowed to capture to.
31 ; We allow site to Use/Not Use the Capture Security Keys based on
32 ; an entry in the Site Parameters File
33 S MAGPLC=$$PLACE^MAGBAPI(DUZ(2))
34 S MAGKEY=+$P($G(^MAG(2006.1,MAGPLC,"KEYS")),U)
35 I 'MAGKEY D Q
36 . S X="" F S X=$O(^MCAR(697.2,"B",X)) Q:X="" D
37 . . S I=$O(^MCAR(697.2,"B",X,"")) S Z=X
38 . . S Y=^MCAR(697.2,I,0)
39 . . Q:'$D(^MAG(2005.03,$P($P(Y,U,2),"(",2)))
40 . . S CT=CT+1
41 . . S MAGRY(CT)=Z_U_$P(Y,U,8)_U_$P(Y,U,2)_U_I
42 D PROCS(.DUZ,.TEMP)
43 S (X,CT)=0 F S X=$O(TEMP(X)) Q:X'?1N.N D
44 . Q:'$D(^XUSEC("MAGCAP MED "_$P(TEMP(X),U,5),DUZ))
45 . S CT=CT+1,MAGRY(CT)=TEMP(X)
46 Q
47PRC(MAGRY,MAGGZY) ;RPC [MAGGPATPROC]
48 ; Call to return a List of Patient Procedures
49 ; in subspeciality, or all
50 ; MAGGZY is a '^' delimited string of 4 pieces.
51 ; $p(1) = Internal entry number of the Subspecialty
52 ; i.e. ^MCAR(697.2,IEN)
53 ; $P(2) = DFN
54 ; $P(3) = TO DATE (external format)
55 ; $P(4) = FROM DATE def to TODAY (external format)
56 ; i.e. "43^643^07/03/95"
57 ;
58 N DIQUIET,Y,X,MCFILE,MAGGFI,MAGGFN,MAGDFN,MAGGPN,MAGGD
59 ;
60 IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
61 E S X="ERRA^MAGGTERR",@^%ZOSF("TRAP")
62 S DIQUIET=1 D DT^DICRW
63 ; FILE PATIENT DATE
64 S MAGGFI=+$P(MAGGZY,U),MAGDFN=+$P(MAGGZY,U,2),MAGGD=$P(MAGGZY,U,3)
65 ;
66 I '$D(^MCAR(697.2,MAGGFI)) D Q
67 . S MAGRY(0)="0^NO Specialty # exists "_MAGGFI
68 S MCFILE=$P(^MCAR(697.2,MAGGFI,0),U,2) ; GLOBAL i.e. MCAR(691
69 S MAGGFN=$P(^MCAR(697.2,MAGGFI,0),U) ; NAME i.e. ECHO
70 S MAGGPN=$P(^DPT(MAGDFN,0),U) ; PATIENT NAME
71 ; Call Medicine API to list procedure for patient in this subspecialty
72 D SUB^MCARUTL2(.MAGRY,MAGDFN,MAGGFI)
73 Q
74PROCS(DUZ,PROCS) ;MAGDUZ=DUZ , PROCS IS CALLED BY REFERENCE
75 N IEN,CNT,KEY,NAME,NODE
76 S NAME="",CNT=0
77 F S NAME=$O(^MCAR(697.2,"B",NAME)) Q:NAME="" S IEN=$O(^(NAME,"")) D
78 . Q:IEN'?1N.N
79 . S NODE=$G(^MCAR(697.2,IEN,0)) Q:NODE=""
80 . Q:'$D(^MAG(2005.03,$P($P(NODE,U,2),"(",2)))
81 . S CNT=CNT+1
82 . S $P(PROCS(CNT),U,1)=NAME ;PROCEDURE NAME
83 . S $P(PROCS(CNT),U,2)=$P(NODE,U,8) ;PRINTNAME
84 . S $P(PROCS(CNT),U,3)=$P(NODE,U,2) ;GLOBAL LOCATION
85 . S $P(PROCS(CNT),U,4)=IEN ;PROC/SUBSPEC FILE IEN
86 . S $P(PROCS(CNT),U,5)=$P(NODE,U,4) ;PROCEDURE TYPE
87 Q
Note: See TracBrowser for help on using the repository browser.