MAGJUTL4	;WIRMFO/JHC VistARad subroutines for RPC calls ; 15 Jul 2004  4:34 PM
	;;3.0;IMAGING;**18,76**;Jun 22, 2007;Build 19
	;;Per VHA Directive 2004-038, this routine should not be modified.
	;; +---------------------------------------------------------------+
	;; | 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
	;
CPTGRP(MAGGRY,DATA)	; RPC: MAGJ CPTMATCH
	; FOR INPUT cpt code, return matching cpt's based on grouping criteria:
	; INPUT in DATA: CPT Code ^ Criteria
	; Criteria:
	;   1=Matching cpt
	;   2=Body Part
	;   3=Body Part & Modality
	;  10=Same CPT (used to return short description only)
	; Return: List of CPTs with Short Name:  CPT ^ Short Name
	; MAGGRY holds $NA reference to ^TMP for rpc return
	;   all ref's to MAGGRY use subscript indirection
	;
	N $ETRAP,$ESTACK S $ETRAP="G ERR1^MAGJUTL4"
	N REPLY,DIQUIET,CPT,CRIT,CT,MAGLST,NOD,NODLST
	N MATCHGRP,INDXLST,AND,RET,CPTGLB,CPTIN,CPTIEN,TCPT
	;
	; <*> Issue: Unable get specific body part for some non-specific CPTs (e.g., 75774-ANGIO SELECT EA ADD VESSEL-S)
	;         --> For these, could just return matching CPTs (or equivalent CPT?)
	; 
	; Produce List of cptiens for each INDX of interest
	; AND with next list of cptiens; repeat until no more INDXs
	; build output list of CPT codes (w/ short names [optional])
	S DIQUIET=1 D DT^DICRW
	S CT=0,MAGLST="MAGJCPT"
	K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY  ; assign MAGGRY value
	S CPTIN=$P(DATA,U),CRIT=$P(DATA,U,2)
	S REPLY="0^Getting matching CPT info."
	S:'CRIT CRIT=1 ; default equivalent
	I CPTIN="" S REPLY="0^Invalid CPT code ("_DATA_")." G CPTGRPZ
	I '(CRIT=1!(CRIT=2)!(CRIT=3)!(CRIT=10)) S REPLY="0^Invalid criteria ("_DATA_")." G CPTGRPZ
	S CPTGLB=$NA(^MAG(2006.67))
	S CPTIEN=$O(@CPTGLB@("B",CPTIN,""))
	I 'CPTIEN S REPLY="0^Input CPT code ("_CPTIN_") not defined in CPT Match table." G CPTGRPZ
	S X=@CPTGLB@(CPTIEN,0),MATCHGRP=+$P(X,U,4)
	;CPTMATCH^BODYPART^MDL
	I CRIT=2!(CRIT=3) D
	. S X=0 F  S X=$O(@CPTGLB@(CPTIEN,1,"B",X)) Q:'X  D GETCPTS("BODYPART",X,"",.RET)
	. I CRIT=3 D
	. . M AND=RET K RET S X=0
	. . F  S X=$O(@CPTGLB@(CPTIEN,2,"B",X)) Q:'X  D GETCPTS("MDL",X,.AND,.RET)
	I CRIT=1 D
	. I MATCHGRP,(MATCHGRP'=CPTIEN) S RET(MATCHGRP)="" D GETCPTS("CPTMATCH",MATCHGRP,"",.RET)
	. D GETCPTS("CPTMATCH",CPTIEN,"",.RET)
	I CRIT=10 ; fall through answers this!
	I '$D(RET(CPTIEN)) S RET(CPTIEN)="" ; always report back input cpt
	S IEN=0 F  S IEN=$O(RET(IEN)) Q:'IEN  D
	. N LIN S X=$G(@CPTGLB@(IEN,0))
	. Q:'(X]"")  S TCPT=$P(X,U),LIN=TCPT_U_$P($$CPT^ICPTCOD(TCPT),U,3) ; _U_$$BODPART(IEN,"~")_U_$$MDLLST(IEN,"~")
	. S CT=CT+1,@MAGGRY@(CT)=LIN
	S REPLY=CT_U_"1~ "_CT_" CPT Matches returned for "_CPTIN
CPTGRPZ	;
	S @MAGGRY@(0)=REPLY
	Q
	;
GETCPTS(INDEX,VALUE,AND,OUT)	; return a list of CPTIENS in OUT
	; if array AND is defined, reply only values contained in AND &  the index
	N X,GLBREF,CPTIEN
	S GLBREF=$NA(@CPTGLB@(INDEX,VALUE))
	S CPTIEN=0
	I $D(AND)>9 D
	. F  S CPTIEN=$O(AND(CPTIEN)) Q:CPTIEN=""  I $D(@GLBREF@(CPTIEN)) S OUT(CPTIEN)=""
	E  F  S CPTIEN=$O(@GLBREF@(CPTIEN)) Q:'CPTIEN  D
	. S OUT(CPTIEN)=""
	Q
	;
BODPART(CPTIEN,DLM)	; return DLM-delimited list of body part values for this CPT
	I +$G(CPTIEN)
	E  Q ""
	N LIST,CPTGLB S LIST=""
	S DLM=$E($G(DLM))
	I DLM="" S DLM="^"
	S CPTGLB=$NA(^MAG(2006.67))
	S NOD=0
	F  S NOD=$O(@CPTGLB@(CPTIEN,1,NOD)) Q:'NOD  S X=$P(^(NOD,0),U) I X]"" S LIST=LIST_DLM_X
	Q:$Q $E(LIST,2,999)  Q
	;
MDLLST(CPTIEN,DLM)	; return DLM-delimited list of modality values for this CPT
	I +$G(CPTIEN)
	E  Q ""
	N LIST,CPTGLB S LIST=""
	S DLM=$E($G(DLM))
	I DLM="" S DLM="^"
	S CPTGLB=$NA(^MAG(2006.67))
	S NOD=0
	F  S NOD=$O(@CPTGLB@(CPTIEN,2,NOD)) Q:'NOD  S X=$P(^(NOD,0),U) I X]"" S LIST=LIST_DLM_X
	Q:$Q $E(LIST,2,999)  Q
	;
STATCHK(MAGGRY,DATA)	;
	; RPC: MAGJ RADSTATUSCHECK
	; This may also be accessed by subroutine call. <*> do not change name of EP
	; Exam Status check RPC and subroutine: determine if the exam has been Tech-Verified (at least).
	; Images are assumed to be verified if Exam Status is Examined, or higher status.
	;       ; Input in DATA: RADFN^RADTI^RACNI^RARPT
	;   Input is either RADFN, RADTI, and RACNI; or, RARPT only may be input in piece 4
	;   Return: Code^Text
	;    0 = Problem, or exam was cancelled
	;    1 = Not yet verified
	;    2 = Tech Verified
	;    3 = Radiologist Verified
	;    4 = User is a Radiology professional--always allow access
	;
	N $ETRAP,$ESTACK S $ETRAP="G ERR3^MAGJUTL4"
	N REPLY,STATUS,ORDER,VCAT,STOUT
	N DIQUIET,RARPT,RADFN,RADTI,RACNI
	S DIQUIET=1 D DT^DICRW
	S RADFN=$P(DATA,U),RADTI=$P(DATA,U,2),RACNI=$P(DATA,U,3),RARPT=$P(DATA,U,4)
	S STOUT="",REPLY="0^Getting image verification status."
	I RADFN,RADTI,RACNI
	E  I RARPT D RPT2DPT(RARPT,.X) I X S RADFN=+X,RADTI=$P(X,U,2),RACNI=$P(X,U,3) I RADFN,RADTI,RACNI
	E  S REPLY="0^Image Verification Status request contains invalid case pointer ("_DATA_")" G STATCHKZ
	S STATUS=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,3)
	I STATUS="" S REPLY="0^Image Verification Status request error--no Exam Status is defined for ("_DATA_")" G STATCHKZ
	S VCAT=$P(^RA(72,STATUS,0),U,9),ORDER=$P(^(0),U,3)
	I VCAT]"" D  G STATCHK2:STOUT
	. I "EDT"[VCAT S STOUT=$S(VCAT="E":2,1:3) ; Examined or Interpreted
	. E  I VCAT="W" S STOUT=1 ; Not yet Verified
	I ORDER=9 S STOUT=3  ; Completed exam
	E  I ORDER=0 S REPLY="0^Exam Cancelled"
	E  I ORDER=1 S STOUT=1  ; Waiting for exam
STATCHK2	;
	I STOUT<2 D
	. F X="S","R","T" I $D(^VA(200,"ARC",X,DUZ)) S STOUT=4 Q  ; Radiologist or Tech -- OK to access
STATCHKZ	;
	I STOUT S REPLY=STOUT_U_$S(STOUT=1:"Images not yet verified",STOUT=2:"Images verified by Technologist",STOUT=3:"Images interpreted by Radiologist",STOUT=4:"Radiology professional--OK to view images.",1:"")
	S MAGGRY=REPLY
	Q
	;
REMSCRN(MAGGRY,DATA)	; User set/clear flag to show/not show remote exams only
	; RPC: MAGJ REMOTESCREEN
	;       ; Input in DATA: 1/0 1=show remote only; 0=show all exams
	;   Return: Reply^Code~msg
	;    Reply -- 0=Problem; 1=Success
	;    Code -- 4=Error; 1=ok
	;    msg -- display text if error
	;
	N $ETRAP,$ESTACK S $ETRAP="G ERR3^MAGJUTL4"
	N REPLY
	N DIQUIET S DIQUIET=1 D DT^DICRW
	I $D(DATA),(DATA=0!(DATA=1))
	E  S REPLY="0^4~REMOTESCREEN request has invalid parameter ("_$G(DATA)_")" G REMSCRNZ
	S MAGJOB("REMOTESCREEN")=DATA,REPLY="1^1~"_DATA
REMSCRNZ	;
	S MAGGRY=REPLY
	Q
	;
RPT2DPT(RARPT,RET)	; Input RARPT. Return RET containing exam ss values for ^RADPT
	;
	N DFN,DTI,CNI S (DFN,DTI,CNI)=""
	I RARPT?1N.N,$D(^RARPT(RARPT)) S X=$G(^(RARPT,0)) I X]"" D
	. S X=$P(X,U)
	. S X=$O(^RADPT("ADC",X,0)) I X S DFN=X,DTI=$O(^(X,0)),CNI=$O(^(DTI,0))
	. S RET=DFN_U_DTI_U_CNI
	E  S RET=""
	Q
	;
ERR1	N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR G ERR
ERR3	N ERR S ERR=$$EC^%ZOSV S MAGGRY="0^4~"_ERR
ERR	D @^%ZOSF("ERRTN")
	Q:$Q 1  Q
	;
END	Q  ; 
