Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGNTLR2

MAGNTLR2.m

Go to the documentation of this file. 
  1. 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
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  Q
  1.  ;***** Return all records in TELEREADER READER file (#2006.5843)
  1.  ; RPC: MAG3 TELEREADER READER LIST
  1.  ;
  1.  ; Input Parameters
  1.  ; ================
  1.  ;  No input parameters
  1.  ;  
  1.  ; Return Values
  1.  ; =============
  1.  ; if error found during execution
  1.  ;   MAGRY(0) = "0^Error"
  1.  ; if success
  1.  ;   MAGRY(0)    = "1^#CNT" - where #CNT is a number of records returned
  1.  ;   MAGRY(1)    = "Reader ID^Reader Name^AQ Site ID^AQ Site^AQ Status^
  1.  ;                   Specialty ID^Specialty^Specialty Status^
  1.  ;                   Procedure ID^Procedure^Procedure Status^Procedure User Pref"
  1.  ;   MAGRY(2..n) = "^" delimited string with values of fields listed in MAGRY(1) 
  1.  ;
  1. LREADER(MAGRY) ;RPC [MAG3 TELEREADER READER LIST]
  1.  ;
  1.  N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
  1.  ;
  1.  N D0,D1,D2
  1.  N I0,I1,I2,I3
  1.  N OUT0,OUT1,OUT2,OUT3
  1.  N MSG0,MSG1,MSG2,MSG3,ERR
  1.  N CNT
  1.  N RVAL,RNAME
  1.  N ACQSITE,ACQSITES,ACQSITEN,ACQSITST
  1.  N SPECIDX,SPECIDXS,SPECIDXN
  1.  N PROCIDX,PROCIDXS,PROCIDXU,PROCIDXN
  1.  ;
  1.  S MAGRY(0)="0^Error"
  1.  S MAGRY(1)="Reader ID^Reader Name^AQ Site ID^AQ Site^AQ Station^AQ Status^"
  1.  S MAGRY(1)=MAGRY(1)_"Specialty ID^Specialty^Specialty Status^"
  1.  S MAGRY(1)=MAGRY(1)_"Procedure ID^Procedure^Procedure Status^Procedure User Pref"
  1.  S CNT=1 ; Will skip 0 and 1
  1.  S ERR=0
  1.  S I0=0
  1.  D LIST^DIC(2006.5843,"","@;.01I;.01",,,,,,,,"OUT0","MSG0")
  1.  I $$ISERROR(.MAGRY,.MSG0) Q   ; Set MAGRY and quit if error exists
  1.  F  S I0=$O(OUT0("DILIST","ID",I0)) Q:'I0  D  Q:ERR
  1.  . S RVAL=OUT0("DILIST","ID",I0,".01","I")
  1.  . S RNAME=OUT0("DILIST","ID",I0,".01","E")
  1.  . S D0=OUT0("DILIST","2",I0)
  1.  . D LIST^DIC(2006.58431,","_D0_",","@;.01I;.01;.5I",,,,,,,,"OUT1","MSG1")
  1.  . I $$ISERROR(.MAGRY,.MSG1) S ERR=1 Q   ; Set MAGRY and quit if error exists
  1.  . S I1=0
  1.  . F  S I1=$O(OUT1("DILIST","ID",I1)) Q:'I1  D  Q:ERR
  1.  . . S ACQSITE=OUT1("DILIST","ID",I1,".01","I")
  1.  . . S ACQSITEN=OUT1("DILIST","ID",I1,".01","E")
  1.  . . S ACQSITST=$$GET1^DIQ(4,ACQSITE,99)
  1.  . . S ACQSITES=OUT1("DILIST","ID",I1,".5")
  1.  . . S D1=OUT1("DILIST","2",I1)
  1.  . . D LIST^DIC(2006.584311,","_D1_","_D0_",","@;.01I;.01;.5I",,,,,,,,"OUT2","MSG2")
  1.  . . I $$ISERROR(.MAGRY,.MSG2) S ERR=1 Q   ; Set MAGRY and quit if error exists
  1.  . . S I2=0
  1.  . . F  S I2=$O(OUT2("DILIST","ID",I2)) Q:'I2  D  Q:ERR
  1.  . . . S SPECIDX=OUT2("DILIST","ID",I2,".01","I")
  1.  . . . S SPECIDXN=OUT2("DILIST","ID",I2,".01","E")
  1.  . . . S SPECIDXS=OUT2("DILIST","ID",I2,".5")
  1.  . . . S D2=OUT2("DILIST","2",I2)
  1.  . . . D LIST^DIC(2006.5843111,","_D2_","_D1_","_D0_",","@;.01I;.01;.5I;1I",,,,,,,,"OUT3","MSG3")
  1.  . . . I $$ISERROR(.MAGRY,.MSG3) S ERR=1 Q   ; Set MAGRY and quit if error exists
  1.  . . . S I3=0
  1.  . . . F  S I3=$O(OUT3("DILIST","ID",I3)) Q:'I3  D
  1.  . . . . S PROCIDX=OUT3("DILIST","ID",I3,".01","I")
  1.  . . . . S PROCIDXN=OUT3("DILIST","ID",I3,".01","E")
  1.  . . . . S PROCIDXS=OUT3("DILIST","ID",I3,".5")
  1.  . . . . S PROCIDXU=OUT3("DILIST","ID",I3,"1")
  1.  . . . . S CNT=CNT+1
  1.  . . . . S MAGRY(CNT)=RVAL_U_RNAME_U_ACQSITE_U_ACQSITEN_U_ACQSITST_U_ACQSITES
  1.  . . . . S MAGRY(CNT)=MAGRY(CNT)_U_SPECIDX_U_SPECIDXN_U_SPECIDXS
  1.  . . . . S MAGRY(CNT)=MAGRY(CNT)_U_PROCIDX_U_PROCIDXN_U_PROCIDXS_U_PROCIDXU
  1.  . . . . Q
  1.  . . . Q
  1.  . . Q
  1.  . Q
  1.  I ERR Q
  1.  S MAGRY(0)="1^"_(CNT-1)
  1.  Q
  1.  ;
  1.  ;***** Return all records in CLINICAL SPECIALTY DICOM & HL7 file (#2006.5831)
  1.  ; RPC: MAG3 TELEREADER DHPS LIST
  1.  ;
  1.  ; Input Parameters
  1.  ; ================
  1.  ;  No input parameters
  1.  ;  
  1.  ; Return Values
  1.  ; =============
  1.  ; if error found during execution
  1.  ;   MAGRY(0) = "0^Error"
  1.  ; if success
  1.  ;   MAGRY(0)    = "1^#CNT" - where #CNT is a number of records returned
  1.  ;   MAGRY(1)    = "IEN^Requested Service ID^Requested Service^Procedure ID^Procedure^
  1.  ;                  Specialty Index ID^Specialty Index^Procedure Index ID^Procedure Index
  1.  ;                  CPT CODE ID^CPT CODE^HL7 SUBSCRIBER ID^HL7 SUBSCRIBER^Clinic"
  1.  ;                 
  1.  ;   MAGRY(2..n) = "^" delimited string with values of fields listed in MAGRY(1)
  1.  ;   
  1.  ;   Clinic column is tilda delimited - Clinic ID~Clinic~.... 
  1.  ; 
  1. LDHSP(MAGRY) ;RPC [MAG3 TELEREADER DHPS LIST]
  1.  ;
  1.  N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
  1.  ;
  1.  N I0,I1,D0,CPTIEN,CPTCODE
  1.  N CNT,DEL,DEL1,MLTPL
  1.  N OUT,OUT1,MSG,MSG1
  1.  K MAGRY,OUT,MSG
  1.  S MAGRY(0)="0^Error"
  1.  S MAGRY(1)="IEN^Requested Service ID^Requested Service^Procedure ID^Procedure"
  1.  S MAGRY(1)=MAGRY(1)_"^Specialty Index ID^Specialty Index^Procedure Index ID^Procedure Index"
  1.  S MAGRY(1)=MAGRY(1)_"^Acquisition Site ID^Acquisition Site"
  1.  S MAGRY(1)=MAGRY(1)_"^CPT CODE ID^CPT CODE^HL7 SUBSCRIBER ID^HL7 SUBSCRIBER^Clinic"
  1.  D LIST^DIC(2006.5831,"","@;.01I;.01;2I;2;3I;3;4I;4;5I;5;6;6I;7;7I",,,,,,,,"OUT","MSG")
  1.  Q:$$ISERROR(.MAGRY,.MSG)  ; Set MAGRY and quit if error exists
  1.  S CNT=1 ; Will skip 0 and 1
  1.  S I0=0
  1.  F  S I0=$O(OUT("DILIST","ID",I0)) Q:'I0  D
  1.  . S D0=OUT("DILIST",2,I0)
  1.  . S CNT=CNT+1
  1.  . S MAGRY(CNT)=D0
  1.  . S MAGRY(CNT)=MAGRY(CNT)_U_OUT("DILIST","ID",I0,".01","I")_U_OUT("DILIST","ID",I0,".01","E")  ; Service
  1.  . S MAGRY(CNT)=MAGRY(CNT)_U_OUT("DILIST","ID",I0,"2","I")_U_OUT("DILIST","ID",I0,"2","E")      ; Procedure
  1.  . S MAGRY(CNT)=MAGRY(CNT)_U_OUT("DILIST","ID",I0,"3","I")_U_OUT("DILIST","ID",I0,"3","E")      ; Specialty Index
  1.  . S MAGRY(CNT)=MAGRY(CNT)_U_OUT("DILIST","ID",I0,"4","I")_U_OUT("DILIST","ID",I0,"4","E")      ; Procedure Index
  1.  . S MAGRY(CNT)=MAGRY(CNT)_U_OUT("DILIST","ID",I0,"5","I")_U_OUT("DILIST","ID",I0,"5","E")      ; Acquisition Site
  1.  . S CPTIEN=OUT("DILIST","ID",I0,"6","I")
  1.  . S CPTCODE=$$CPT^ICPTCOD(CPTIEN) ; IA # 1995, supported reference
  1.  . 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
  1.  . S MAGRY(CNT)=MAGRY(CNT)_U_OUT("DILIST","ID",I0,"7","I")_U_OUT("DILIST","ID",I0,"7","E")      ; HL7
  1.  . K OUT1,MSG1
  1.  . D LIST^DIC(2006.58311,","_D0_",","@;.01I;.01",,,,,,,,"OUT1","MSG1")                          ; Clinics
  1.  . S I1=0
  1.  . S MLTPL=""
  1.  . S DEL="",DEL1="~"
  1.  . F  S I1=$O(OUT1("DILIST","ID",I1)) Q:'I1  D
  1.  . . S MLTPL=MLTPL_DEL_OUT1("DILIST","ID",I1,".01","I")_DEL1_OUT1("DILIST","ID",I1,".01","E")
  1.  . . S DEL=DEL1
  1.  . . Q
  1.  . S MAGRY(CNT)=MAGRY(CNT)_U_MLTPL
  1.  . Q
  1.  S MAGRY(0)="1^"_(CNT-1)
  1.  Q
  1.  ;
  1.  ; Input Parameters
  1.  ; ================
  1.  ;  MSG = VA FileMan error array 
  1.  ;  
  1.  ; Return Values
  1.  ; =============
  1.  ;  MAGRY = "0^Error Message"
  1.  ;
  1.  ; Return 1 = error in MSG array
  1.  ;        0 = no error in MSG array
  1. ISERROR(MAGRY,MSG)   ; Check for error message
  1.  I '$D(MSG("DIERR")) Q 0  ; No error
  1.  ;
  1.  N MAGRESA
  1.  D MSG^DIALOG("A",.MAGRESA,245,5,"MSG")
  1.  S MAGRY(0)="0^"_MAGRESA(1)
  1.  Q 1