MAGNTLR7 ;WOIFO/NST - TeleReader Configuration utilities ; 30 Apr 2012 11:19 AM
;;3.0;IMAGING;**138**;Mar 19, 2002;Build 5380;Sep 03, 2013
;; 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
;
;***** Get CPT Codes list by searching CPT Code description
;
; RPC: MAG3 TELEREADER CPT CODELOOKUP
;
; .MAGRY Reference to a local variable where the results are returned to.
;
; Input Parameters
; ================
; MAGFIND = Look up CPT code description value
;
; Return Values
; =============
; A list with CPT CODES for consult or procedure request.
;
; if error
; MAGRY(0) = 0 ^ Error message
; if success
; MAGRY(0) = 1 ^ Number of records return
; MAGRY(1..n) = CPT CODE IEN^ CPT CODE ^ Description
;
; Notes
; =====
; Temporary global nodes ^TMP("LEXFND",$J),^TMP("LEXHIT",$J),^TMP("LEXSCH",$J),^TMP("LEXLE",$J)
; are used by this procedure.
;
CPTFIND(LST,MAGFIND) ; RPC [MAG3 TELEREADER CPT CODELOOKUP]
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
; Borrowed from LEX^ORWPCE
N X,APP,ORDATE ; Parameters in LEX^ORWPCE
N LEX,DIC
S X=MAGFIND
S APP="CHP"
K LST
;
S:APP="CPT" APP="CHP" ; LEX PATCH 10
S:'+$G(ORDATE) ORDATE=DT
D CONFIG^LEXSET(APP,APP,ORDATE) ;DBIA 1609
I APP="CHP" D
. ; Set the filter for CPT only using CS APIs - format is the same as for DIC("S")
. S ^TMP("LEXSCH",$J,"FIL",0)="I $L($$CPTONE^LEXU(+Y,$G(ORDATE)))!($L($$CPCONE^LEXU(+Y,$G(ORDATE))))" ;DBIA 1609
. ; Set Applications Default Flag (Lexicon can not overwrite filter)
. S ^TMP("LEXSCH",$J,"ADF",0)=1
D LOOK^LEXA(X,APP,1,"",ORDATE) ;DBIA 2950
I '$D(LEX("LIST",1)) D QUIT
. D LEXX
. S LST(0)="0^No matches found."
D LIST(.LEX) ; prepare the result
D LEXX ; Clean up temp globals
Q
;
LIST(LEX) ; Generate the list
N CPTCODE,CPTIEN
N ILST,I,IEN
;
S ILST=0
S IEN=$P(LEX("LIST",1),U)
S CPTCODE=$$CPTONE^LEXU(IEN,ORDATE) ;DBIA 1573
I CPTCODE'="" D
. S CPTIEN=$P($$CPT^ICPTCOD(CPTCODE),U) ;IA # 1995, supported reference
. S:CPTIEN>0 ILST=ILST+1,LST(ILST)=CPTIEN_U_CPTCODE_U_$P(LEX("LIST",1),U,2)
. Q
;
S (I,IEN)=""
F S I=$O(^TMP("LEXFND",$J,I)) Q:I="" D ;DBIA 2950
. F S IEN=$O(^TMP("LEXFND",$J,I,IEN)) Q:IEN="" D
. . S CPTCODE=$$CPTONE^LEXU(IEN,ORDATE) ; IA 1573
. . Q:CPTCODE=""
. . S CPTIEN=$P($$CPT^ICPTCOD(CPTCODE),U) ; IA # 1995, supported reference
. . Q:CPTIEN'>0
. . S ILST=ILST+1,LST(ILST)=CPTIEN_U_CPTCODE_U_^TMP("LEXFND",$J,I,IEN)
S LST(0)=1_"^"_ILST
Q
;
LEXX ; Clean up temp globals
K ^TMP("LEXFND",$J),^TMP("LEXHIT",$J),^TMP("LEXSCH",$J),^TMP("LEXLE",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGNTLR7 3571 printed Sep 23, 2025@19:43:42 Page 2
MAGNTLR7 ;WOIFO/NST - TeleReader Configuration utilities ; 30 Apr 2012 11:19 AM
+1 ;;3.0;IMAGING;**138**;Mar 19, 2002;Build 5380;Sep 03, 2013
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+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 ;; | 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
+18 ;
+19 ;***** Get CPT Codes list by searching CPT Code description
+20 ;
+21 ; RPC: MAG3 TELEREADER CPT CODELOOKUP
+22 ;
+23 ; .MAGRY Reference to a local variable where the results are returned to.
+24 ;
+25 ; Input Parameters
+26 ; ================
+27 ; MAGFIND = Look up CPT code description value
+28 ;
+29 ; Return Values
+30 ; =============
+31 ; A list with CPT CODES for consult or procedure request.
+32 ;
+33 ; if error
+34 ; MAGRY(0) = 0 ^ Error message
+35 ; if success
+36 ; MAGRY(0) = 1 ^ Number of records return
+37 ; MAGRY(1..n) = CPT CODE IEN^ CPT CODE ^ Description
+38 ;
+39 ; Notes
+40 ; =====
+41 ; Temporary global nodes ^TMP("LEXFND",$J),^TMP("LEXHIT",$J),^TMP("LEXSCH",$J),^TMP("LEXLE",$J)
+42 ; are used by this procedure.
+43 ;
CPTFIND(LST,MAGFIND) ; RPC [MAG3 TELEREADER CPT CODELOOKUP]
+1 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGGTERR"
+2 ; Borrowed from LEX^ORWPCE
+3 ; Parameters in LEX^ORWPCE
NEW X,APP,ORDATE
+4 NEW LEX,DIC
+5 SET X=MAGFIND
+6 SET APP="CHP"
+7 KILL LST
+8 ;
+9 ; LEX PATCH 10
if APP="CPT"
SET APP="CHP"
+10 if '+$GET(ORDATE)
SET ORDATE=DT
+11 ;DBIA 1609
DO CONFIG^LEXSET(APP,APP,ORDATE)
+12 IF APP="CHP"
Begin DoDot:1
+13 ; Set the filter for CPT only using CS APIs - format is the same as for DIC("S")
+14 ;DBIA 1609
SET ^TMP("LEXSCH",$JOB,"FIL",0)="I $L($$CPTONE^LEXU(+Y,$G(ORDATE)))!($L($$CPCONE^LEXU(+Y,$G(ORDATE))))"
+15 ; Set Applications Default Flag (Lexicon can not overwrite filter)
+16 SET ^TMP("LEXSCH",$JOB,"ADF",0)=1
End DoDot:1
+17 ;DBIA 2950
DO LOOK^LEXA(X,APP,1,"",ORDATE)
+18 IF '$DATA(LEX("LIST",1))
Begin DoDot:1
+19 DO LEXX
+20 SET LST(0)="0^No matches found."
End DoDot:1
QUIT
+21 ; prepare the result
DO LIST(.LEX)
+22 ; Clean up temp globals
DO LEXX
+23 QUIT
+24 ;
LIST(LEX) ; Generate the list
+1 NEW CPTCODE,CPTIEN
+2 NEW ILST,I,IEN
+3 ;
+4 SET ILST=0
+5 SET IEN=$PIECE(LEX("LIST",1),U)
+6 ;DBIA 1573
SET CPTCODE=$$CPTONE^LEXU(IEN,ORDATE)
+7 IF CPTCODE'=""
Begin DoDot:1
+8 ;IA # 1995, supported reference
SET CPTIEN=$PIECE($$CPT^ICPTCOD(CPTCODE),U)
+9 if CPTIEN>0
SET ILST=ILST+1
SET LST(ILST)=CPTIEN_U_CPTCODE_U_$PIECE(LEX("LIST",1),U,2)
+10 QUIT
End DoDot:1
+11 ;
+12 SET (I,IEN)=""
+13 ;DBIA 2950
FOR
SET I=$ORDER(^TMP("LEXFND",$JOB,I))
if I=""
QUIT
Begin DoDot:1
+14 FOR
SET IEN=$ORDER(^TMP("LEXFND",$JOB,I,IEN))
if IEN=""
QUIT
Begin DoDot:2
+15 ; IA 1573
SET CPTCODE=$$CPTONE^LEXU(IEN,ORDATE)
+16 if CPTCODE=""
QUIT
+17 ; IA # 1995, supported reference
SET CPTIEN=$PIECE($$CPT^ICPTCOD(CPTCODE),U)
+18 if CPTIEN'>0
QUIT
+19 SET ILST=ILST+1
SET LST(ILST)=CPTIEN_U_CPTCODE_U_^TMP("LEXFND",$JOB,I,IEN)
End DoDot:2
End DoDot:1
+20 SET LST(0)=1_"^"_ILST
+21 QUIT
+22 ;
LEXX ; Clean up temp globals
+1 KILL ^TMP("LEXFND",$JOB),^TMP("LEXHIT",$JOB),^TMP("LEXSCH",$JOB),^TMP("LEXLE",$JOB)
+2 QUIT
