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

VPSRPC14.m

Go to the documentation of this file. 
  1. VPSRPC14  ;BPOIFO/KG - Patient Radiology/Imaging Exams;07/31/14 13:07
  1.  ;;1.0;VA POINT OF SERVICE (KIOSKS);**4**;Jul 31, 2014;Build 27
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; External Reference DBIA#
  1.  ; ------------------------
  1.  ; #3288 - LIST^ORQOR1                              (Controlled subs)
  1.  ; #6101 - ORDOC^ORPR07                             (Private)
  1.  ; #2266 - EN30^RAO7PC1                             (Supported)
  1.  ; #6102 - READ ACCESS TO File #100, Field 6,33     (Private)
  1.  ; #3074 - READ ACCESS TO File #75.1, Field 16,20   (Private)
  1.  ; #65   - READ ACCESS TO File #70.03, Field 2,3,17 (Controlled Subs)
  1.  ; #65   - READ ACCESS TO File #70.02, Field 2      (Controlled Subs)
  1.  ; #586  - READ ACCESS TO File #71, Field 9         (Controlled Subs)
  1.  ; #3505 - READ ACCESS TO File #79.2, Field .01,3   (Controlled Subs)
  1.  QUIT
  1.  ;
  1. GETRAD(VPSARR,DFN,PARAMS) ;given DFN, returns the patient radiology/imaging exams
  1.  N DATA,EXAMINFO,RIOIEN,RIOIENS,RIOINFO,ORDINFO,CPT,ORDIEN,ORDIENS,PROC,PROCIEN,PROCNAME,PROVNAME
  1.  N IENS7002,IENS7003,DTI,CASE,DTI,TYPIEN,TYPIENS,TYPINFO,ACTIEN
  1.  ;
  1.  ;Get Radiology/Imaging orders from ORDER File (#100)
  1.  N FILTER S FILTER=1 ;all orders
  1.  N EXIST S EXIST=0
  1.  S PARAMS=$G(PARAMS)
  1.  N STDTE S STDTE=$P(PARAMS,":")
  1.  N ENDTE S ENDTE=$P(PARAMS,":",2)
  1.  N ORDLST D LIST^ORQOR1(.ORDLST,DFN,"IMAGING",FILTER,STDTE,ENDTE)
  1.  ;
  1.  I +$P($G(ORDLST(1)),U,1)>0 D
  1.  . N CNT S CNT=""
  1.  . F  S CNT=+$O(ORDLST(CNT)) Q:CNT'>0  D
  1.  . . S EXIST=1
  1.  . . S DATA=ORDLST(CNT)
  1.  . . S ORDIEN=$P($P(DATA,U,1),";",1)
  1.  . . S ACTIEN=$P($P(DATA,U,1),";",2)
  1.  . . Q:ORDIEN=""
  1.  . . S ORDIENS=ORDIEN_","
  1.  . . K ORDINFO
  1.  . . D GETS^DIQ(100,ORDIENS,"6;33","IE","ORDINFO")
  1.  . . S PROVNAME=$$ORDOC^ORPR07(ORDIEN,ACTIEN)
  1.  . . S PROCNAME=$P(DATA,U,2)
  1.  . . D SET(.VPSARR,100,DFN_";"_ORDIEN,.01,ORDIEN,"CPRS ORDER IEN")
  1.  . . D SET(.VPSARR,100,DFN_";"_ORDIEN,1,PROCNAME,"PROCEDURE NAME")
  1.  . . D SET(.VPSARR,100,DFN_";"_ORDIEN,6,$G(ORDINFO(100,ORDIENS,6,"E")),"REQUESTING LOCATION")
  1.  . . D SET(.VPSARR,100.008,DFN_";"_ORDIEN_";"_ACTIEN,3,PROVNAME,"REQUESTING PHYSICIAN")
  1.  . . ;
  1.  . . ;get info from Radiology/Imaging Order File (#75.1)
  1.  . . S RIOIEN=+$G(ORDINFO(100,ORDIENS,33,"I")) ;radiology/imaging order, pointer to 75.1
  1.  . . Q:RIOIEN'>0
  1.  . . S RIOIENS=RIOIEN_","
  1.  . . K RIOINFO
  1.  . . D GETS^DIQ(75.1,RIOIENS,"16;20","IE","RIOINFO")
  1.  . . D SET(.VPSARR,75.1,DFN_";"_RIOIEN,16,$G(RIOINFO(75.1,RIOIENS,16,"E")),"EXAM REQUESTED DATE")
  1.  . . D SET(.VPSARR,75.1,DFN_";"_RIOIEN,20,$G(RIOINFO(75.1,RIOIENS,20,"E")),"IMAGING LOCATION NAME")
  1.  . . ;
  1.  . . ;get Exam info from Radiology/Imaging Patient File (#70)
  1.  . . D EN30^RAO7PC1(RIOIEN)   ;DBIA 2266
  1.  . . Q:'$D(^TMP($J,"RAE2",DFN))  ;no examinations
  1.  . . S DTI=+$O(^RADPT("AO",RIOIEN,DFN,0)) Q:'DTI
  1.  . . S CASE=+$O(^TMP($J,"RAE2",DFN,0)) Q:'CASE
  1.  . . S PROC=$O(^TMP($J,"RAE2",DFN,CASE,""))
  1.  . . S DATA=^TMP($J,"RAE2",DFN,CASE,PROC)
  1.  . . ;
  1.  . . S IENS7002=DTI_","_DFN_","     ;IENS for #70.02
  1.  . . S TYPIEN=$$GET1^DIQ(70.02,IENS7002,"2","I")
  1.  . . S TYPIENS=TYPIEN_","
  1.  . . K TYPINFO
  1.  . . D GETS^DIQ(79.2,TYPIENS,".01;3","IE","TYPINFO")
  1.  . . D SET(.VPSARR,79.2,DFN_";"_TYPIEN,.01,$G(TYPINFO(79.2,TYPIENS,.01,"E")),"IMAGING TYPE ABBR")
  1.  . . D SET(.VPSARR,79.2,DFN_";"_TYPIEN,3,$G(TYPINFO(79.2,TYPIENS,3,"E")),"IMAGING TYPE NAME")
  1.  . . ;
  1.  . . S IENS7003=CASE_","_IENS7002   ;IENS for #70.03
  1.  . . D SET(.VPSARR,70.03,DFN_";"_IENS7003,.01,CASE,"RADIOLOGY CASE#")
  1.  . . D SET(.VPSARR,70.03,DFN_";"_IENS7003,17,$P(DATA,U,1),"REPORT STATUS")
  1.  . . D SET(.VPSARR,70.03,DFN_";"_IENS7003,13,$P(DATA,U,2),"ABNORMAL RESULTS FLAG")
  1.  . . K EXAMINFO
  1.  . . D GETS^DIQ(70.03,IENS7003,"2;3;17","IE","EXAMINFO")
  1.  . . D SET(.VPSARR,70.03,DFN_";"_IENS7003,3,$G(EXAMINFO(70.03,IENS7003,3,"I")),"EXAM STATUS ORDER#")
  1.  . . D SET(.VPSARR,70.03,DFN_";"_IENS7003,3,$G(EXAMINFO(70.03,IENS7003,3,"E")),"EXAM STATUS NAME")
  1.  . . D SET(.VPSARR,70.03,DFN_";"_IENS7003,17,$G(EXAMINFO(70.03,IENS7003,17,"I")),"REPORT IEN")
  1.  . . ;
  1.  . . S PROCIEN=$G(EXAMINFO(70.03,IENS7003,2,"I"))  ;Procedure IEN, pointer to File #71
  1.  . . S CPT=$$GET1^DIQ(71,PROCIEN_",",9,"I")
  1.  . . D SET(.VPSARR,71,DFN_";"_PROCIEN,9,CPT,"CPT CODE")
  1.  ;
  1.  I 'EXIST D SET(.VPSARR,"E",DFN,"","NO RAD ORDERS FOUND FOR PATIENT","RAD NOT FOUND")
  1.  QUIT
  1.  ;
  1. SET(VPSARR,VPSFL,VPSIEN,VPSFLD,VPSDA,VPSDS) ;Set line item to output array
  1.  I VPSDA'="" D SET^VPSRPC1(.VPSARR,VPSFL,VPSIEN,VPSFLD,VPSDA,$G(VPSDS),4) ;Set line item to output array
  1.  QUIT