source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJUTL4.m@ 724

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

revised back to 6/30/08 version

File size: 7.4 KB
Line 
1MAGJUTL4 ;WIRMFO/JHC VistARad subroutines for RPC calls ; 15 Jul 2004 4:34 PM
2 ;;3.0;IMAGING;**18**;Mar 07, 2006
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
19 ;
20CPTGRP(MAGGRY,DATA) ; RPC: MAGJ CPTMATCH
21 ; FOR INPUT cpt code, return matching cpt's based on grouping criteria:
22 ; INPUT in DATA: CPT Code ^ Criteria
23 ; Criteria:
24 ; 1=Matching cpt
25 ; 2=Body Part
26 ; 3=Body Part & Modality
27 ; 10=Same CPT (used to return short description only)
28 ; Return: List of CPTs with Short Name: CPT ^ Short Name
29 ; MAGGRY holds $NA reference to ^TMP for rpc return
30 ; all ref's to MAGGRY use subscript indirection
31 ;
32 N $ETRAP,$ESTACK S $ETRAP="G ERR1^MAGJUTL4"
33 N REPLY,DIQUIET,CPT,CRIT,CT,MAGLST,NOD,NODLST
34 N MATCHGRP,INDXLST,AND,RET,CPTGLB,CPTIN,CPTIEN,TCPT
35 ;
36 ; <*> Issue: Unable get specific body part for some non-specific CPTs (e.g., 75774-ANGIO SELECT EA ADD VESSEL-S)
37 ; --> For these, could just return matching CPTs (or equivalent CPT?)
38 ;
39 ; Produce List of cptiens for each INDX of interest
40 ; AND with next list of cptiens; repeat until no more INDXs
41 ; build output list of CPT codes (w/ short names [optional])
42 S DIQUIET=1 D DT^DICRW
43 S CT=0,MAGLST="MAGJCPT"
44 K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY ; assign MAGGRY value
45 S CPTIN=$P(DATA,U),CRIT=$P(DATA,U,2)
46 S REPLY="0^Getting matching CPT info."
47 S:'CRIT CRIT=1 ; default equivalent
48 I CPTIN="" S REPLY="0^Invalid CPT code ("_DATA_")." G CPTGRPZ
49 I '(CRIT=1!(CRIT=2)!(CRIT=3)!(CRIT=10)) S REPLY="0^Invalid criteria ("_DATA_")." G CPTGRPZ
50 S CPTGLB=$NA(^MAG(2006.67))
51 S CPTIEN=$O(@CPTGLB@("B",CPTIN,""))
52 I 'CPTIEN S REPLY="0^Input CPT code ("_CPTIN_") not defined in CPT Match table." G CPTGRPZ
53 S X=@CPTGLB@(CPTIEN,0),MATCHGRP=+$P(X,U,4)
54 ;CPTMATCH^BODYPART^MDL
55 I CRIT=2!(CRIT=3) D
56 . S X=0 F S X=$O(@CPTGLB@(CPTIEN,1,"B",X)) Q:'X D GETCPTS("BODYPART",X,"",.RET)
57 . I CRIT=3 D
58 . . M AND=RET K RET S X=0
59 . . F S X=$O(@CPTGLB@(CPTIEN,2,"B",X)) Q:'X D GETCPTS("MDL",X,.AND,.RET)
60 I CRIT=1 D
61 . I MATCHGRP,(MATCHGRP'=CPTIEN) S RET(MATCHGRP)="" D GETCPTS("CPTMATCH",MATCHGRP,"",.RET)
62 . D GETCPTS("CPTMATCH",CPTIEN,"",.RET)
63 I CRIT=10 ; fall through answers this!
64 I '$D(RET(CPTIEN)) S RET(CPTIEN)="" ; always report back input cpt
65 S IEN=0 F S IEN=$O(RET(IEN)) Q:'IEN D
66 . N LIN S X=$G(@CPTGLB@(IEN,0))
67 . Q:'(X]"") S TCPT=$P(X,U),LIN=TCPT_U_$P($G(^ICPT(TCPT,0)),U,2) ; _U_$$BODPART(IEN,"~")_U_$$MDLLST(IEN,"~")
68 . S CT=CT+1,@MAGGRY@(CT)=LIN
69 S REPLY=CT_U_"1~ "_CT_" CPT Matches returned for "_CPTIN
70CPTGRPZ ;
71 S @MAGGRY@(0)=REPLY
72 Q
73 ;
74GETCPTS(INDEX,VALUE,AND,OUT) ; return a list of CPTIENS in OUT
75 ; if array AND is defined, reply only values contained in AND & the index
76 N X,GLBREF,CPTIEN
77 S GLBREF=$NA(@CPTGLB@(INDEX,VALUE))
78 S CPTIEN=0
79 I $D(AND)>9 D
80 . F S CPTIEN=$O(AND(CPTIEN)) Q:CPTIEN="" I $D(@GLBREF@(CPTIEN)) S OUT(CPTIEN)=""
81 E F S CPTIEN=$O(@GLBREF@(CPTIEN)) Q:'CPTIEN D
82 . S OUT(CPTIEN)=""
83 Q
84 ;
85BODPART(CPTIEN,DLM) ; return DLM-delimited list of body part values for this CPT
86 I +$G(CPTIEN)
87 E Q ""
88 N LIST,CPTGLB S LIST=""
89 S DLM=$E($G(DLM))
90 I DLM="" S DLM="^"
91 S CPTGLB=$NA(^MAG(2006.67))
92 S NOD=0
93 F S NOD=$O(@CPTGLB@(CPTIEN,1,NOD)) Q:'NOD S X=$P(^(NOD,0),U) I X]"" S LIST=LIST_DLM_X
94 Q:$Q $E(LIST,2,999) Q
95 ;
96MDLLST(CPTIEN,DLM) ; return DLM-delimited list of modality values for this CPT
97 I +$G(CPTIEN)
98 E Q ""
99 N LIST,CPTGLB S LIST=""
100 S DLM=$E($G(DLM))
101 I DLM="" S DLM="^"
102 S CPTGLB=$NA(^MAG(2006.67))
103 S NOD=0
104 F S NOD=$O(@CPTGLB@(CPTIEN,2,NOD)) Q:'NOD S X=$P(^(NOD,0),U) I X]"" S LIST=LIST_DLM_X
105 Q:$Q $E(LIST,2,999) Q
106 ;
107STATCHK(MAGGRY,DATA) ;
108 ; RPC: MAGJ RADSTATUSCHECK
109 ; This may also be accessed by subroutine call. <*> do not change name of EP
110 ; Exam Status check RPC and subroutine: determine if the exam has been Tech-Verified (at least).
111 ; Images are assumed to be verified if Exam Status is Examined, or higher status.
112 ; ; Input in DATA: RADFN^RADTI^RACNI^RARPT
113 ; Input is either RADFN, RADTI, and RACNI; or, RARPT only may be input in piece 4
114 ; Return: Code^Text
115 ; 0 = Problem, or exam was cancelled
116 ; 1 = Not yet verified
117 ; 2 = Tech Verified
118 ; 3 = Radiologist Verified
119 ; 4 = User is a Radiology professional--always allow access
120 ;
121 N $ETRAP,$ESTACK S $ETRAP="G ERR3^MAGJUTL4"
122 N REPLY,STATUS,ORDER,VCAT,STOUT
123 N DIQUIET,RARPT,RADFN,RADTI,RACNI
124 S DIQUIET=1 D DT^DICRW
125 S RADFN=$P(DATA,U),RADTI=$P(DATA,U,2),RACNI=$P(DATA,U,3),RARPT=$P(DATA,U,4)
126 S STOUT="",REPLY="0^Getting image verification status."
127 I RADFN,RADTI,RACNI
128 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
129 E S REPLY="0^Image Verification Status request contains invalid case pointer ("_DATA_")" G STATCHKZ
130 S STATUS=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,3)
131 I STATUS="" S REPLY="0^Image Verification Status request error--no Exam Status is defined for ("_DATA_")" G STATCHKZ
132 S VCAT=$P(^RA(72,STATUS,0),U,9),ORDER=$P(^(0),U,3)
133 I VCAT]"" D G STATCHK2:STOUT
134 . I "EDT"[VCAT S STOUT=$S(VCAT="E":2,1:3) ; Examined or Interpreted
135 . E I VCAT="W" S STOUT=1 ; Not yet Verified
136 I ORDER=9 S STOUT=3 ; Completed exam
137 E I ORDER=0 S REPLY="0^Exam Cancelled"
138 E I ORDER=1 S STOUT=1 ; Waiting for exam
139STATCHK2 ;
140 I STOUT<2 D
141 . F X="S","R","T" I $D(^VA(200,"ARC",X,DUZ)) S STOUT=4 Q ; Radiologist or Tech -- OK to access
142STATCHKZ ;
143 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:"")
144 S MAGGRY=REPLY
145 Q
146 ;
147REMSCRN(MAGGRY,DATA) ; User set/clear flag to show/not show remote exams only
148 ; RPC: MAGJ REMOTESCREEN
149 ; ; Input in DATA: 1/0 1=show remote only; 0=show all exams
150 ; Return: Reply^Code~msg
151 ; Reply -- 0=Problem; 1=Success
152 ; Code -- 4=Error; 1=ok
153 ; msg -- display text if error
154 ;
155 N $ETRAP,$ESTACK S $ETRAP="G ERR3^MAGJUTL4"
156 N REPLY
157 N DIQUIET S DIQUIET=1 D DT^DICRW
158 I $D(DATA),(DATA=0!(DATA=1))
159 E S REPLY="0^4~REMOTESCREEN request has invalid parameter ("_$G(DATA)_")" G REMSCRNZ
160 S MAGJOB("REMOTESCREEN")=DATA,REPLY="1^1~"_DATA
161REMSCRNZ ;
162 S MAGGRY=REPLY
163 Q
164 ;
165RPT2DPT(RARPT,RET) ; Input RARPT. Return RET containing exam ss values for ^RADPT
166 ;
167 N DFN,DTI,CNI S (DFN,DTI,CNI)=""
168 I RARPT?1N.N,$D(^RARPT(RARPT)) S X=$G(^(RARPT,0)) I X]"" D
169 . S X=$P(X,U)
170 . S X=$O(^RADPT("ADC",X,0)) I X S DFN=X,DTI=$O(^(X,0)),CNI=$O(^(DTI,0))
171 . S RET=DFN_U_DTI_U_CNI
172 E S RET=""
173 Q
174 ;
175ERR1 N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR G ERR
176ERR3 N ERR S ERR=$$EC^%ZOSV S MAGGRY="0^4~"_ERR
177ERR D @^%ZOSF("ERRTN")
178 Q:$Q 1 Q
179 ;
180END Q ;
Note: See TracBrowser for help on using the repository browser.