88 lines
3.8 KiB
Mathematica
88 lines
3.8 KiB
Mathematica
MAGGTMC ;WOIFO/GEK - RPC Calls for Imaging/Medicine procedures ; [ 06/20/2001 08:56 ]
|
|
;;3.0;IMAGING;**8**;Sep 15, 2004
|
|
;; +---------------------------------------------------------------+
|
|
;; | Property of the US Government. |
|
|
;; | No permission to copy or redistribute this software is given. |
|
|
;; | Use of unreleased versions of this software requires the user |
|
|
;; | to execute a written test agreement with the VistA Imaging |
|
|
;; | Development Office of the Department of Veterans Affairs, |
|
|
;; | telephone (301) 734-0100. |
|
|
;; | |
|
|
;; | The Food and Drug Administration classifies this software as |
|
|
;; | a medical device. As such, it may not be changed in any way. |
|
|
;; | Modifications to this software may result in an adulterated |
|
|
;; | medical device under 21CFR820, the use of which is considered |
|
|
;; | to be a violation of US Federal Statutes. |
|
|
;; +---------------------------------------------------------------+
|
|
;;
|
|
Q
|
|
LIST(MAGRY,MAGGZY) ;RPC [MAGGLISTPROC]
|
|
; Call to return a list of procedures/subspecialities
|
|
;MAGGZY NOT USED in Version 2.5
|
|
; if MAGGZY=1 then add procedure PRINT NAME (full name) in output
|
|
; returns list of NAME PRINT NAME ^ GLOBAL ^ IEN
|
|
; i.e. "ECG ELECTROCARDIOGRAM^MCAR(691.5^2"
|
|
IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
|
|
E S X="ERRA^MAGGTERR",@^%ZOSF("TRAP")
|
|
N X,Y,Z,I,CT,PRCSTR,MAGKEY,TEMP,MAGPLC
|
|
S CT=0
|
|
; Now we will check keys for medicine procedures the user is
|
|
; allowed to capture to.
|
|
; We allow site to Use/Not Use the Capture Security Keys based on
|
|
; an entry in the Site Parameters File
|
|
S MAGPLC=$$PLACE^MAGBAPI(DUZ(2))
|
|
S MAGKEY=+$P($G(^MAG(2006.1,MAGPLC,"KEYS")),U)
|
|
I 'MAGKEY D Q
|
|
. S X="" F S X=$O(^MCAR(697.2,"B",X)) Q:X="" D
|
|
. . S I=$O(^MCAR(697.2,"B",X,"")) S Z=X
|
|
. . S Y=^MCAR(697.2,I,0)
|
|
. . Q:'$D(^MAG(2005.03,$P($P(Y,U,2),"(",2)))
|
|
. . S CT=CT+1
|
|
. . S MAGRY(CT)=Z_U_$P(Y,U,8)_U_$P(Y,U,2)_U_I
|
|
D PROCS(.DUZ,.TEMP)
|
|
S (X,CT)=0 F S X=$O(TEMP(X)) Q:X'?1N.N D
|
|
. Q:'$D(^XUSEC("MAGCAP MED "_$P(TEMP(X),U,5),DUZ))
|
|
. S CT=CT+1,MAGRY(CT)=TEMP(X)
|
|
Q
|
|
PRC(MAGRY,MAGGZY) ;RPC [MAGGPATPROC]
|
|
; Call to return a List of Patient Procedures
|
|
; in subspeciality, or all
|
|
; MAGGZY is a '^' delimited string of 4 pieces.
|
|
; $p(1) = Internal entry number of the Subspecialty
|
|
; i.e. ^MCAR(697.2,IEN)
|
|
; $P(2) = DFN
|
|
; $P(3) = TO DATE (external format)
|
|
; $P(4) = FROM DATE def to TODAY (external format)
|
|
; i.e. "43^643^07/03/95"
|
|
;
|
|
N DIQUIET,Y,X,MCFILE,MAGGFI,MAGGFN,MAGDFN,MAGGPN,MAGGD
|
|
;
|
|
IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
|
|
E S X="ERRA^MAGGTERR",@^%ZOSF("TRAP")
|
|
S DIQUIET=1 D DT^DICRW
|
|
; FILE PATIENT DATE
|
|
S MAGGFI=+$P(MAGGZY,U),MAGDFN=+$P(MAGGZY,U,2),MAGGD=$P(MAGGZY,U,3)
|
|
;
|
|
I '$D(^MCAR(697.2,MAGGFI)) D Q
|
|
. S MAGRY(0)="0^NO Specialty # exists "_MAGGFI
|
|
S MCFILE=$P(^MCAR(697.2,MAGGFI,0),U,2) ; GLOBAL i.e. MCAR(691
|
|
S MAGGFN=$P(^MCAR(697.2,MAGGFI,0),U) ; NAME i.e. ECHO
|
|
S MAGGPN=$P(^DPT(MAGDFN,0),U) ; PATIENT NAME
|
|
; Call Medicine API to list procedure for patient in this subspecialty
|
|
D SUB^MCARUTL2(.MAGRY,MAGDFN,MAGGFI)
|
|
Q
|
|
PROCS(DUZ,PROCS) ;MAGDUZ=DUZ , PROCS IS CALLED BY REFERENCE
|
|
N IEN,CNT,KEY,NAME,NODE
|
|
S NAME="",CNT=0
|
|
F S NAME=$O(^MCAR(697.2,"B",NAME)) Q:NAME="" S IEN=$O(^(NAME,"")) D
|
|
. Q:IEN'?1N.N
|
|
. S NODE=$G(^MCAR(697.2,IEN,0)) Q:NODE=""
|
|
. Q:'$D(^MAG(2005.03,$P($P(NODE,U,2),"(",2)))
|
|
. S CNT=CNT+1
|
|
. S $P(PROCS(CNT),U,1)=NAME ;PROCEDURE NAME
|
|
. S $P(PROCS(CNT),U,2)=$P(NODE,U,8) ;PRINTNAME
|
|
. S $P(PROCS(CNT),U,3)=$P(NODE,U,2) ;GLOBAL LOCATION
|
|
. S $P(PROCS(CNT),U,4)=IEN ;PROC/SUBSPEC FILE IEN
|
|
. S $P(PROCS(CNT),U,5)=$P(NODE,U,4) ;PROCEDURE TYPE
|
|
Q
|