MAGNTLR2 ;WOIFO/NST - TeleReader Configuration ; 25 Mar 2013 10:35 AM
;;3.0;IMAGING;**114,127,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
;***** Return all records in TELEREADER READER file (#2006.5843)
; RPC: MAG3 TELEREADER READER LIST
;
; Input Parameters
; ================
; No input parameters
;
; Return Values
; =============
; if error found during execution
; MAGRY(0) = "0^Error"
; if success
; MAGRY(0) = "1^#CNT" - where #CNT is a number of records returned
; MAGRY(1) = "Reader ID^Reader Name^AQ Site ID^AQ Site^AQ Status^
; Specialty ID^Specialty^Specialty Status^
; Procedure ID^Procedure^Procedure Status^Procedure User Pref"
; MAGRY(2..n) = "^" delimited string with values of fields listed in MAGRY(1)
;
LREADER(MAGRY) ;RPC [MAG3 TELEREADER READER LIST]
;
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
;
N D0,D1,D2
N I0,I1,I2,I3
N OUT0,OUT1,OUT2,OUT3
N MSG0,MSG1,MSG2,MSG3,ERR
N CNT
N RVAL,RNAME
N ACQSITE,ACQSITES,ACQSITEN,ACQSITST
N SPECIDX,SPECIDXS,SPECIDXN
N PROCIDX,PROCIDXS,PROCIDXU,PROCIDXN
;
S MAGRY(0)="0^Error"
S MAGRY(1)="Reader ID^Reader Name^AQ Site ID^AQ Site^AQ Station^AQ Status^"
S MAGRY(1)=MAGRY(1)_"Specialty ID^Specialty^Specialty Status^"
S MAGRY(1)=MAGRY(1)_"Procedure ID^Procedure^Procedure Status^Procedure User Pref"
S CNT=1 ; Will skip 0 and 1
S ERR=0
S I0=0
D LIST^DIC(2006.5843,"","@;.01I;.01",,,,,,,,"OUT0","MSG0")
I $$ISERROR(.MAGRY,.MSG0) Q ; Set MAGRY and quit if error exists
F S I0=$O(OUT0("DILIST","ID",I0)) Q:'I0 D Q:ERR
. S RVAL=OUT0("DILIST","ID",I0,".01","I")
. S RNAME=OUT0("DILIST","ID",I0,".01","E")
. S D0=OUT0("DILIST","2",I0)
. D LIST^DIC(2006.58431,","_D0_",","@;.01I;.01;.5I",,,,,,,,"OUT1","MSG1")
. I $$ISERROR(.MAGRY,.MSG1) S ERR=1 Q ; Set MAGRY and quit if error exists
. S I1=0
. F S I1=$O(OUT1("DILIST","ID",I1)) Q:'I1 D Q:ERR
. . S ACQSITE=OUT1("DILIST","ID",I1,".01","I")
. . S ACQSITEN=OUT1("DILIST","ID",I1,".01","E")
. . S ACQSITST=$$GET1^DIQ(4,ACQSITE,99)
. . S ACQSITES=OUT1("DILIST","ID",I1,".5")
. . S D1=OUT1("DILIST","2",I1)
. . D LIST^DIC(2006.584311,","_D1_","_D0_",","@;.01I;.01;.5I",,,,,,,,"OUT2","MSG2")
. . I $$ISERROR(.MAGRY,.MSG2) S ERR=1 Q ; Set MAGRY and quit if error exists
. . S I2=0
. . F S I2=$O(OUT2("DILIST","ID",I2)) Q:'I2 D Q:ERR
. . . S SPECIDX=OUT2("DILIST","ID",I2,".01","I")
. . . S SPECIDXN=OUT2("DILIST","ID",I2,".01","E")
. . . S SPECIDXS=OUT2("DILIST","ID",I2,".5")
. . . S D2=OUT2("DILIST","2",I2)
. . . D LIST^DIC(2006.5843111,","_D2_","_D1_","_D0_",","@;.01I;.01;.5I;1I",,,,,,,,"OUT3","MSG3")
. . . I $$ISERROR(.MAGRY,.MSG3) S ERR=1 Q ; Set MAGRY and quit if error exists
. . . S I3=0
. . . F S I3=$O(OUT3("DILIST","ID",I3)) Q:'I3 D
. . . . S PROCIDX=OUT3("DILIST","ID",I3,".01","I")
. . . . S PROCIDXN=OUT3("DILIST","ID",I3,".01","E")
. . . . S PROCIDXS=OUT3("DILIST","ID",I3,".5")
. . . . S PROCIDXU=OUT3("DILIST","ID",I3,"1")
. . . . S CNT=CNT+1
. . . . S MAGRY(CNT)=RVAL_U_RNAME_U_ACQSITE_U_ACQSITEN_U_ACQSITST_U_ACQSITES
. . . . S MAGRY(CNT)=MAGRY(CNT)_U_SPECIDX_U_SPECIDXN_U_SPECIDXS
. . . . S MAGRY(CNT)=MAGRY(CNT)_U_PROCIDX_U_PROCIDXN_U_PROCIDXS_U_PROCIDXU
. . . . Q
. . . Q
. . Q
. Q
I ERR Q
S MAGRY(0)="1^"_(CNT-1)
Q
;
;***** Return all records in CLINICAL SPECIALTY DICOM & HL7 file (#2006.5831)
; RPC: MAG3 TELEREADER DHPS LIST
;
; Input Parameters
; ================
; No input parameters
;
; Return Values
; =============
; if error found during execution
; MAGRY(0) = "0^Error"
; if success
; MAGRY(0) = "1^#CNT" - where #CNT is a number of records returned
; MAGRY(1) = "IEN^Requested Service ID^Requested Service^Procedure ID^Procedure^
; Specialty Index ID^Specialty Index^Procedure Index ID^Procedure Index
; CPT CODE ID^CPT CODE^HL7 SUBSCRIBER ID^HL7 SUBSCRIBER^Clinic"
;
; MAGRY(2..n) = "^" delimited string with values of fields listed in MAGRY(1)
;
; Clinic column is tilda delimited - Clinic ID~Clinic~....
;
LDHSP(MAGRY) ;RPC [MAG3 TELEREADER DHPS LIST]
;
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
;
N I0,I1,D0,CPTIEN,CPTCODE
N CNT,DEL,DEL1,MLTPL
N OUT,OUT1,MSG,MSG1
K MAGRY,OUT,MSG
S MAGRY(0)="0^Error"
S MAGRY(1)="IEN^Requested Service ID^Requested Service^Procedure ID^Procedure"
S MAGRY(1)=MAGRY(1)_"^Specialty Index ID^Specialty Index^Procedure Index ID^Procedure Index"
S MAGRY(1)=MAGRY(1)_"^Acquisition Site ID^Acquisition Site"
S MAGRY(1)=MAGRY(1)_"^CPT CODE ID^CPT CODE^HL7 SUBSCRIBER ID^HL7 SUBSCRIBER^Clinic"
D LIST^DIC(2006.5831,"","@;.01I;.01;2I;2;3I;3;4I;4;5I;5;6;6I;7;7I",,,,,,,,"OUT","MSG")
Q:$$ISERROR(.MAGRY,.MSG) ; Set MAGRY and quit if error exists
S CNT=1 ; Will skip 0 and 1
S I0=0
F S I0=$O(OUT("DILIST","ID",I0)) Q:'I0 D
. S D0=OUT("DILIST",2,I0)
. S CNT=CNT+1
. S MAGRY(CNT)=D0
. S MAGRY(CNT)=MAGRY(CNT)_U_OUT("DILIST","ID",I0,".01","I")_U_OUT("DILIST","ID",I0,".01","E") ; Service
. S MAGRY(CNT)=MAGRY(CNT)_U_OUT("DILIST","ID",I0,"2","I")_U_OUT("DILIST","ID",I0,"2","E") ; Procedure
. S MAGRY(CNT)=MAGRY(CNT)_U_OUT("DILIST","ID",I0,"3","I")_U_OUT("DILIST","ID",I0,"3","E") ; Specialty Index
. S MAGRY(CNT)=MAGRY(CNT)_U_OUT("DILIST","ID",I0,"4","I")_U_OUT("DILIST","ID",I0,"4","E") ; Procedure Index
. S MAGRY(CNT)=MAGRY(CNT)_U_OUT("DILIST","ID",I0,"5","I")_U_OUT("DILIST","ID",I0,"5","E") ; Acquisition Site
. S CPTIEN=OUT("DILIST","ID",I0,"6","I")
. S CPTCODE=$$CPT^ICPTCOD(CPTIEN) ; IA # 1995, supported reference
. S MAGRY(CNT)=MAGRY(CNT)_U_OUT("DILIST","ID",I0,"6","I")_U_OUT("DILIST","ID",I0,"6","E")_" "_$P(CPTCODE,U,3) ; CPT CODE
. S MAGRY(CNT)=MAGRY(CNT)_U_OUT("DILIST","ID",I0,"7","I")_U_OUT("DILIST","ID",I0,"7","E") ; HL7
. K OUT1,MSG1
. D LIST^DIC(2006.58311,","_D0_",","@;.01I;.01",,,,,,,,"OUT1","MSG1") ; Clinics
. S I1=0
. S MLTPL=""
. S DEL="",DEL1="~"
. F S I1=$O(OUT1("DILIST","ID",I1)) Q:'I1 D
. . S MLTPL=MLTPL_DEL_OUT1("DILIST","ID",I1,".01","I")_DEL1_OUT1("DILIST","ID",I1,".01","E")
. . S DEL=DEL1
. . Q
. S MAGRY(CNT)=MAGRY(CNT)_U_MLTPL
. Q
S MAGRY(0)="1^"_(CNT-1)
Q
;
; Input Parameters
; ================
; MSG = VA FileMan error array
;
; Return Values
; =============
; MAGRY = "0^Error Message"
;
; Return 1 = error in MSG array
; 0 = no error in MSG array
ISERROR(MAGRY,MSG) ; Check for error message
I '$D(MSG("DIERR")) Q 0 ; No error
;
N MAGRESA
D MSG^DIALOG("A",.MAGRESA,245,5,"MSG")
S MAGRY(0)="0^"_MAGRESA(1)
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGNTLR2 7765 printed Dec 13, 2024@02:07:20 Page 2
MAGNTLR2 ;WOIFO/NST - TeleReader Configuration ; 25 Mar 2013 10:35 AM
+1 ;;3.0;IMAGING;**114,127,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 ;***** Return all records in TELEREADER READER file (#2006.5843)
+19 ; RPC: MAG3 TELEREADER READER LIST
+20 ;
+21 ; Input Parameters
+22 ; ================
+23 ; No input parameters
+24 ;
+25 ; Return Values
+26 ; =============
+27 ; if error found during execution
+28 ; MAGRY(0) = "0^Error"
+29 ; if success
+30 ; MAGRY(0) = "1^#CNT" - where #CNT is a number of records returned
+31 ; MAGRY(1) = "Reader ID^Reader Name^AQ Site ID^AQ Site^AQ Status^
+32 ; Specialty ID^Specialty^Specialty Status^
+33 ; Procedure ID^Procedure^Procedure Status^Procedure User Pref"
+34 ; MAGRY(2..n) = "^" delimited string with values of fields listed in MAGRY(1)
+35 ;
LREADER(MAGRY) ;RPC [MAG3 TELEREADER READER LIST]
+1 ;
+2 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGGTERR"
+3 ;
+4 NEW D0,D1,D2
+5 NEW I0,I1,I2,I3
+6 NEW OUT0,OUT1,OUT2,OUT3
+7 NEW MSG0,MSG1,MSG2,MSG3,ERR
+8 NEW CNT
+9 NEW RVAL,RNAME
+10 NEW ACQSITE,ACQSITES,ACQSITEN,ACQSITST
+11 NEW SPECIDX,SPECIDXS,SPECIDXN
+12 NEW PROCIDX,PROCIDXS,PROCIDXU,PROCIDXN
+13 ;
+14 SET MAGRY(0)="0^Error"
+15 SET MAGRY(1)="Reader ID^Reader Name^AQ Site ID^AQ Site^AQ Station^AQ Status^"
+16 SET MAGRY(1)=MAGRY(1)_"Specialty ID^Specialty^Specialty Status^"
+17 SET MAGRY(1)=MAGRY(1)_"Procedure ID^Procedure^Procedure Status^Procedure User Pref"
+18 ; Will skip 0 and 1
SET CNT=1
+19 SET ERR=0
+20 SET I0=0
+21 DO LIST^DIC(2006.5843,"","@;.01I;.01",,,,,,,,"OUT0","MSG0")
+22 ; Set MAGRY and quit if error exists
IF $$ISERROR(.MAGRY,.MSG0)
QUIT
+23 FOR
SET I0=$ORDER(OUT0("DILIST","ID",I0))
if 'I0
QUIT
Begin DoDot:1
+24 SET RVAL=OUT0("DILIST","ID",I0,".01","I")
+25 SET RNAME=OUT0("DILIST","ID",I0,".01","E")
+26 SET D0=OUT0("DILIST","2",I0)
+27 DO LIST^DIC(2006.58431,","_D0_",","@;.01I;.01;.5I",,,,,,,,"OUT1","MSG1")
+28 ; Set MAGRY and quit if error exists
IF $$ISERROR(.MAGRY,.MSG1)
SET ERR=1
QUIT
+29 SET I1=0
+30 FOR
SET I1=$ORDER(OUT1("DILIST","ID",I1))
if 'I1
QUIT
Begin DoDot:2
+31 SET ACQSITE=OUT1("DILIST","ID",I1,".01","I")
+32 SET ACQSITEN=OUT1("DILIST","ID",I1,".01","E")
+33 SET ACQSITST=$$GET1^DIQ(4,ACQSITE,99)
+34 SET ACQSITES=OUT1("DILIST","ID",I1,".5")
+35 SET D1=OUT1("DILIST","2",I1)
+36 DO LIST^DIC(2006.584311,","_D1_","_D0_",","@;.01I;.01;.5I",,,,,,,,"OUT2","MSG2")
+37 ; Set MAGRY and quit if error exists
IF $$ISERROR(.MAGRY,.MSG2)
SET ERR=1
QUIT
+38 SET I2=0
+39 FOR
SET I2=$ORDER(OUT2("DILIST","ID",I2))
if 'I2
QUIT
Begin DoDot:3
+40 SET SPECIDX=OUT2("DILIST","ID",I2,".01","I")
+41 SET SPECIDXN=OUT2("DILIST","ID",I2,".01","E")
+42 SET SPECIDXS=OUT2("DILIST","ID",I2,".5")
+43 SET D2=OUT2("DILIST","2",I2)
+44 DO LIST^DIC(2006.5843111,","_D2_","_D1_","_D0_",","@;.01I;.01;.5I;1I",,,,,,,,"OUT3","MSG3")
+45 ; Set MAGRY and quit if error exists
IF $$ISERROR(.MAGRY,.MSG3)
SET ERR=1
QUIT
+46 SET I3=0
+47 FOR
SET I3=$ORDER(OUT3("DILIST","ID",I3))
if 'I3
QUIT
Begin DoDot:4
+48 SET PROCIDX=OUT3("DILIST","ID",I3,".01","I")
+49 SET PROCIDXN=OUT3("DILIST","ID",I3,".01","E")
+50 SET PROCIDXS=OUT3("DILIST","ID",I3,".5")
+51 SET PROCIDXU=OUT3("DILIST","ID",I3,"1")
+52 SET CNT=CNT+1
+53 SET MAGRY(CNT)=RVAL_U_RNAME_U_ACQSITE_U_ACQSITEN_U_ACQSITST_U_ACQSITES
+54 SET MAGRY(CNT)=MAGRY(CNT)_U_SPECIDX_U_SPECIDXN_U_SPECIDXS
+55 SET MAGRY(CNT)=MAGRY(CNT)_U_PROCIDX_U_PROCIDXN_U_PROCIDXS_U_PROCIDXU
+56 QUIT
End DoDot:4
+57 QUIT
End DoDot:3
if ERR
QUIT
+58 QUIT
End DoDot:2
if ERR
QUIT
+59 QUIT
End DoDot:1
if ERR
QUIT
+60 IF ERR
QUIT
+61 SET MAGRY(0)="1^"_(CNT-1)
+62 QUIT
+63 ;
+64 ;***** Return all records in CLINICAL SPECIALTY DICOM & HL7 file (#2006.5831)
+65 ; RPC: MAG3 TELEREADER DHPS LIST
+66 ;
+67 ; Input Parameters
+68 ; ================
+69 ; No input parameters
+70 ;
+71 ; Return Values
+72 ; =============
+73 ; if error found during execution
+74 ; MAGRY(0) = "0^Error"
+75 ; if success
+76 ; MAGRY(0) = "1^#CNT" - where #CNT is a number of records returned
+77 ; MAGRY(1) = "IEN^Requested Service ID^Requested Service^Procedure ID^Procedure^
+78 ; Specialty Index ID^Specialty Index^Procedure Index ID^Procedure Index
+79 ; CPT CODE ID^CPT CODE^HL7 SUBSCRIBER ID^HL7 SUBSCRIBER^Clinic"
+80 ;
+81 ; MAGRY(2..n) = "^" delimited string with values of fields listed in MAGRY(1)
+82 ;
+83 ; Clinic column is tilda delimited - Clinic ID~Clinic~....
+84 ;
LDHSP(MAGRY) ;RPC [MAG3 TELEREADER DHPS LIST]
+1 ;
+2 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGGTERR"
+3 ;
+4 NEW I0,I1,D0,CPTIEN,CPTCODE
+5 NEW CNT,DEL,DEL1,MLTPL
+6 NEW OUT,OUT1,MSG,MSG1
+7 KILL MAGRY,OUT,MSG
+8 SET MAGRY(0)="0^Error"
+9 SET MAGRY(1)="IEN^Requested Service ID^Requested Service^Procedure ID^Procedure"
+10 SET MAGRY(1)=MAGRY(1)_"^Specialty Index ID^Specialty Index^Procedure Index ID^Procedure Index"
+11 SET MAGRY(1)=MAGRY(1)_"^Acquisition Site ID^Acquisition Site"
+12 SET MAGRY(1)=MAGRY(1)_"^CPT CODE ID^CPT CODE^HL7 SUBSCRIBER ID^HL7 SUBSCRIBER^Clinic"
+13 DO LIST^DIC(2006.5831,"","@;.01I;.01;2I;2;3I;3;4I;4;5I;5;6;6I;7;7I",,,,,,,,"OUT","MSG")
+14 ; Set MAGRY and quit if error exists
if $$ISERROR(.MAGRY,.MSG)
QUIT
+15 ; Will skip 0 and 1
SET CNT=1
+16 SET I0=0
+17 FOR
SET I0=$ORDER(OUT("DILIST","ID",I0))
if 'I0
QUIT
Begin DoDot:1
+18 SET D0=OUT("DILIST",2,I0)
+19 SET CNT=CNT+1
+20 SET MAGRY(CNT)=D0
+21 ; Service
SET MAGRY(CNT)=MAGRY(CNT)_U_OUT("DILIST","ID",I0,".01","I")_U_OUT("DILIST","ID",I0,".01","E")
+22 ; Procedure
SET MAGRY(CNT)=MAGRY(CNT)_U_OUT("DILIST","ID",I0,"2","I")_U_OUT("DILIST","ID",I0,"2","E")
+23 ; Specialty Index
SET MAGRY(CNT)=MAGRY(CNT)_U_OUT("DILIST","ID",I0,"3","I")_U_OUT("DILIST","ID",I0,"3","E")
+24 ; Procedure Index
SET MAGRY(CNT)=MAGRY(CNT)_U_OUT("DILIST","ID",I0,"4","I")_U_OUT("DILIST","ID",I0,"4","E")
+25 ; Acquisition Site
SET MAGRY(CNT)=MAGRY(CNT)_U_OUT("DILIST","ID",I0,"5","I")_U_OUT("DILIST","ID",I0,"5","E")
+26 SET CPTIEN=OUT("DILIST","ID",I0,"6","I")
+27 ; IA # 1995, supported reference
SET CPTCODE=$$CPT^ICPTCOD(CPTIEN)
+28 ; CPT CODE
SET MAGRY(CNT)=MAGRY(CNT)_U_OUT("DILIST","ID",I0,"6","I")_U_OUT("DILIST","ID",I0,"6","E")_" "_$PIECE(CPTCODE,U,3)
+29 ; HL7
SET MAGRY(CNT)=MAGRY(CNT)_U_OUT("DILIST","ID",I0,"7","I")_U_OUT("DILIST","ID",I0,"7","E")
+30 KILL OUT1,MSG1
+31 ; Clinics
DO LIST^DIC(2006.58311,","_D0_",","@;.01I;.01",,,,,,,,"OUT1","MSG1")
+32 SET I1=0
+33 SET MLTPL=""
+34 SET DEL=""
SET DEL1="~"
+35 FOR
SET I1=$ORDER(OUT1("DILIST","ID",I1))
if 'I1
QUIT
Begin DoDot:2
+36 SET MLTPL=MLTPL_DEL_OUT1("DILIST","ID",I1,".01","I")_DEL1_OUT1("DILIST","ID",I1,".01","E")
+37 SET DEL=DEL1
+38 QUIT
End DoDot:2
+39 SET MAGRY(CNT)=MAGRY(CNT)_U_MLTPL
+40 QUIT
End DoDot:1
+41 SET MAGRY(0)="1^"_(CNT-1)
+42 QUIT
+43 ;
+44 ; Input Parameters
+45 ; ================
+46 ; MSG = VA FileMan error array
+47 ;
+48 ; Return Values
+49 ; =============
+50 ; MAGRY = "0^Error Message"
+51 ;
+52 ; Return 1 = error in MSG array
+53 ; 0 = no error in MSG array
ISERROR(MAGRY,MSG) ; Check for error message
+1 ; No error
IF '$DATA(MSG("DIERR"))
QUIT 0
+2 ;
+3 NEW MAGRESA
+4 DO MSG^DIALOG("A",.MAGRESA,245,5,"MSG")
+5 SET MAGRY(0)="0^"_MAGRESA(1)
+6 QUIT 1
