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