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

VPRSDAR.m

Go to the documentation of this file. 
  1. VPRSDAR ;SLC/MKB -- SDA Radiology utilities ;8/6/18  12:21
  1.  ;;1.0;VIRTUAL PATIENT RECORD;**8,10,30**;Sep 01, 2011;Build 9
  1.  ;;Per VHA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; External References          DBIA#
  1.  ; -------------------          -----
  1.  ; ^OR(100                       5771
  1.  ; ^RADPT                   2480,2588
  1.  ; ^RARPT                        5605
  1.  ; DIQ                           2056
  1.  ; RAO7PC1                  2043,2265
  1.  ; RAO7PC3                       2877
  1.  ;
  1. PRE ; -- PreProcessing for VPR RAD ORDER
  1.  ;  Expects DFN, DSTRT, DSTOP, DMAX from EN^DDEGET
  1.  N BEG,END,MAX,RAORD
  1.  S BEG=$G(DSTRT),END=$G(DSTOP),MAX=$G(DMAX)_"P"
  1.  I $G(ID) D  ;reset for one order
  1.  . S RAORD=+$G(^OR(100,+ID,4)) S:'DFN DFN=+$P($G(^(0)),U,2)
  1.  . S IDT=$O(^RADPT("AO",RAORD,DFN,0))
  1.  . S:IDT (BEG,END)=9999999.9999-IDT
  1.  K ^TMP($J,"RAE1") D EN1^RAO7PC1(DFN,BEG,END,MAX)
  1.  Q
  1.  ;
  1. POST ; -- PostProcessing for VPR RAD ORDER
  1.  K ^TMP($J,"RAE1",DFN),^TMP($J,"RAE2",DFN)
  1.  K VPRAE1,VPRAE2,RARPT,RAPROC,ORPK
  1.  Q
  1.  ;
  1. ONE(RAID) ; -- ID Processing for each VPR RAD RESULT (RAID = #75.1 ien)
  1.  ;  Returns VPRAE1 = ^TMP($J,"RAE1",DFN,Exam ID)
  1.  ;          VPRAE2 = $NA(^TMP($J,"RAE2",DFN,caseIEN,procedureName))
  1.  ;          RARPT  = Report #74 IEN
  1.  ;          RAPROC = Procedure name
  1.  ;          RAID   = #70.03 IEN string
  1.  ;
  1.  N IDT,CASE,EXAM,TYPE
  1.  S IDT=+$O(^RADPT("AO",+$G(RAID),DFN,0)),CASE=+$O(^(IDT,0))
  1.  I CASE<1 S DDEOUT=1 Q
  1.  S EXAM=IDT_"-"_CASE K RARPT
  1.  ; get [1st] exam node
  1.  S VPRAE1=$G(^TMP($J,"RAE1",DFN,EXAM)),STS=$P(VPRAE1,U,3)
  1.  I STS="No Report"!(STS="Deleted")!(STS["Draft")!(STS["Released/Not") S DDEOUT=1 Q
  1.  S RARPT=+$P(VPRAE1,U,5) I RARPT<1 S DDEOUT=1 Q
  1.  ; get report details for [1st] exam/case, save array name for reference
  1.  K ^TMP($J,"RAE2") D EN30^RAO7PC1(RAID)
  1.  I '$D(^TMP($J,"RAE2",DFN,CASE)) S DDEOUT=1 Q
  1.  S VPRAE2=$Q(^TMP($J,"RAE2",DFN)),RAID=CASE_","_IDT_","_DFN
  1.  ; get procedure for DocumentName, list of report iens if examset
  1.  S TYPE=$G(^TMP($J,"RAE1",DFN,EXAM,"CPRS"))
  1.  I +TYPE=0 S RAPROC=$P(VPRAE1,U)    ;1 case/report
  1.  I +TYPE=2 S RAPROC=$P(TYPE,U,2)    ;1 report (print set)
  1.  I +TYPE=1 S RAPROC=$P(TYPE,U,2) D  ;exam set
  1.  . N RAE1,RPT S RARPT(CASE)=RARPT_";RA"
  1.  . F  S CASE=$O(^TMP($J,"RAE2",DFN,CASE)) Q:CASE<1  D
  1.  .. S EXAM=IDT_"-"_CASE
  1.  .. S RAE1=$G(^TMP($J,"RAE1",DFN,EXAM)),STS=$P(RAE1,U,3)
  1.  .. Q:STS="No Report"!(STS="Deleted")!(STS["Draft")!(STS["Released/Not")
  1.  .. S RPT=+$P(RAE1,U,5) S:RPT RARPT(CASE)=RPT_";RA"
  1.  Q
  1.  ;
  1. ABN() ; -- return "A" if any report for exam(s) is abnormal, else null
  1.  N X,Y,CASE S Y=""
  1.  I $D(RARPT)<9 D  Q Y
  1.  . S Y=$S($P(VPRAE1,U,4)="Y":"A",1:"") ;,$P(VPRAE1,U,9)="Y":"A"
  1.  S CASE=0 F  S CASE=$O(^TMP($J,"RAE2",DFN,CASE)) Q:CASE<1  D  Q:$L(Y)
  1.  . S X=$Q(^TMP($J,"RAE2",DFN,CASE))
  1.  . S:$P(@X,U,2)="Y" Y="A"
  1.  Q Y
  1.  ;
  1.  ; -- for Documents container:
  1.  ;
  1. RPTS ; -- find patient's radiology reports
  1.  N VPRN,VPRXID,STS,RARPT
  1.  S DFN=+$G(DFN) Q:DFN<1
  1.  K ^TMP($J,"RAE1") D EN1^RAO7PC1(DFN,DSTRT,DSTOP,DMAX_"P")
  1.  S VPRN=0 ; VPRXID = invdate.time-caseIEN
  1.  S VPRXID="" F  S VPRXID=$O(^TMP($J,"RAE1",DFN,VPRXID)) Q:VPRXID=""  D
  1.  . S STS=$P($G(^TMP($J,"RAE1",DFN,VPRXID)),U,3),RARPT=+$P($G(^(VPRXID)),U,5)
  1.  . Q:STS="No Report"!(STS="Deleted")!(STS["Draft")!(STS["Released/Not")
  1.  . Q:RARPT<1  Q:$D(RARPT(RARPT))  ;already have report, for sets
  1.  . S VPRN=+$G(VPRN)+1,DLIST(VPRN)=RARPT_"~"_VPRXID
  1.  . S RARPT(+RARPT)=""
  1.  K ^TMP($J,"RAE1")
  1.  Q
  1.  ;
  1. RPT1 ; -- ID Processing for each VPR RAD REPORT
  1.  ;  Returns VPRXID = Exam-Case ID
  1.  ;          VPRAE2 = $NA(^TMP($J,"RAE2",DFN,caseIEN,procedureName))
  1.  ;          VPRAE3 = $NA(^TMP($J,"RAE3",DFN,caseIEN,procedureName))
  1.  ;          RAPROC = Procedure name
  1.  ;
  1.  N RA0,X
  1.  S VPRXID=$P(DIEN,"~",2),DIEN=+$P(DIEN,"~")
  1.  S RA0=$G(^RARPT(DIEN,0)) S:DFN<1 DFN=+$P(RA0,U,2)
  1.  I 'VPRXID D
  1.  . N I S VPRXID=9999999.9999-$P(RA0,U,3),I=0
  1.  . F  S I=$O(^RADPT(DFN,"DT",VPRXID,"P",I)) Q:I<1  I $P($G(^(I,0)),U,17)=DIEN S VPRXID=VPRXID_"-"_I Q
  1.  I $L(VPRXID,"-")<2 S DDEOUT=1 Q
  1.  S X=DFN_U_$TR(VPRXID,"-","^") D
  1.  . N DFN,RACNT,RAMDIV,RAWHOVER,RAPRTSET
  1.  . K ^TMP($J,"RAE2"),^TMP($J,"RAE3")
  1.  . D EN3^RAO7PC1(X),EN3^RAO7PC3(X)
  1.  S VPRAE2=$Q(^TMP($J,"RAE2",DFN)),VPRAE3=$Q(^TMP($J,"RAE3",DFN))
  1.  ; get [ordered] procedure for document name
  1.  I $D(^TMP($J,"RAE3",DFN,"PRINT_SET")) S RAPROC=$G(^("ORD"))
  1.  E  S RAPROC=$QS(VPRAE3,5)
  1.  Q
  1.  ;
  1. VNUM(DFN,EXAMID) ; -- return Visit# for patient, examID
  1.  N I,IDT,IENS,Y
  1.  S I=+$P(EXAMID,"-",2),IDT=$P(EXAMID,"-"),IENS=I_","_IDT_","_DFN_","
  1.  S Y=$$GET1^DIQ(70.03,IENS,27,"I")
  1.  Q Y