| [623] | 1 | MAGJUTL4 ;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 | ;
|
|---|
| 20 | CPTGRP(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
|
|---|
| 70 | CPTGRPZ ;
|
|---|
| 71 | S @MAGGRY@(0)=REPLY
|
|---|
| 72 | Q
|
|---|
| 73 | ;
|
|---|
| 74 | GETCPTS(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 | ;
|
|---|
| 85 | BODPART(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 | ;
|
|---|
| 96 | MDLLST(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 | ;
|
|---|
| 107 | STATCHK(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
|
|---|
| 139 | STATCHK2 ;
|
|---|
| 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
|
|---|
| 142 | STATCHKZ ;
|
|---|
| 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 | ;
|
|---|
| 147 | REMSCRN(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
|
|---|
| 161 | REMSCRNZ ;
|
|---|
| 162 | S MAGGRY=REPLY
|
|---|
| 163 | Q
|
|---|
| 164 | ;
|
|---|
| 165 | RPT2DPT(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 | ;
|
|---|
| 175 | ERR1 N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR G ERR
|
|---|
| 176 | ERR3 N ERR S ERR=$$EC^%ZOSV S MAGGRY="0^4~"_ERR
|
|---|
| 177 | ERR D @^%ZOSF("ERRTN")
|
|---|
| 178 | Q:$Q 1 Q
|
|---|
| 179 | ;
|
|---|
| 180 | END Q ;
|
|---|
