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

VPRDJ07.m

Go to the documentation of this file. 
  1. VPRDJ07 ;SLC/MKB -- Radiology,Surgery ;6/25/12  16:11
  1.  ;;1.0;VIRTUAL PATIENT RECORD;**2**;Sep 01, 2011;Build 317
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; External References          DBIA#
  1.  ; -------------------          -----
  1.  ; ^SC                          10040
  1.  ; ^VA(200                      10060
  1.  ; DIC                           2051
  1.  ; DIQ                           2056
  1.  ; RAO7PC1                  2043,2265
  1.  ; SROESTV                       3533
  1.  ;
  1.  ; All tags expect DFN, ID, [VPRSTART, VPRSTOP, VPRMAX, VPRTEXT]
  1.  ;
  1. RA1(ID) ; -- radiology exam ^TMP($J,"RAE1",DFN,ID)
  1.  N EXAM,X0,SET,PROC,DATE,LOC,X,Y,IENS,ID3,N
  1.  S X0=$G(^TMP($J,"RAE1",DFN,ID)),SET=$G(^(ID,"CPRS")),PROC=$P(X0,U) Q:X0=""
  1.  S EXAM("localId")=ID,EXAM("uid")=$$SETUID^VPRUTILS("image",DFN,ID)
  1.  S EXAM("name")=PROC,EXAM("case")=$P(X0,U,2),EXAM("category")="RA"
  1.  S DATE=9999999.9999-+ID,EXAM("dateTime")=$$JSONDT^VPRUTILS(DATE)
  1.  I $P(X0,U,5) D  ;report exists
  1.  . N NM S NM=$S(+SET=2:$P(SET,U,2),1:PROC) ;2 = shared report
  1.  . S EXAM("results",1,"uid")=$$SETUID^VPRUTILS("document",DFN,ID)
  1.  . S EXAM("results",1,"localTitle")=NM
  1.  . S EXAM("verified")=$S($E($P(X0,U,3))="V":"true",1:"false")
  1.  S:$L($P(X0,U,6)) EXAM("statusName")=$P($P(X0,U,6),"~",2)
  1.  S X=$P(X0,U,7),LOC="" I $L(X) D
  1.  . S EXAM("imageLocation")=X,EXAM("locationName")=X
  1.  . S LOC=+$O(^SC("B",X,0))
  1.  . S EXAM("locationUid")=$$SETUID^VPRUTILS("location",,LOC)
  1.  S X=$$FAC^VPRD(LOC) D FACILITY^VPRUTILS(X,"EXAM")
  1.  I $L($P(X0,U,8)) S X=$P($P(X0,U,8),"~",2),EXAM("imagingTypeUid")=$$SETVURN^VPRUTILS("imaging-Type",X)
  1.  S X=$P(X0,U,10) I X D
  1.  . N CPT S CPT=$$CPT^VPRDRA(X)
  1.  . S (EXAM("typeName"),EXAM("summary"))=$P(CPT,U,2)
  1.  . ;I $D(^TMP($J,"RAE1",DFN,ID,"CMOD")) M EXAM("modifier")=^("CMOD")
  1.  I $P(X0,U,11) D
  1.  . S EXAM("orderUid")=$$SETUID^VPRUTILS("order",DFN,+$P(X0,U,11))
  1.  . S EXAM("orderName")=$S($L(SET):$P(SET,U,2),1:PROC)
  1.  S EXAM("hasImages")=$S($P(X0,U,12)="Y":"true",1:"false")
  1.  I $P(X0,U,4)="Y"!($P(X0,U,9)="Y") S EXAM("interpretation")="ABNORMAL"
  1.  S IENS=$P(ID,"-",2)_","_+ID_","_DFN_","
  1.  S X=$$GET1^DIQ(70.03,IENS,27,"I") I X D
  1.  . S EXAM("encounterUid")=$$SETUID^VPRUTILS("visit",DFN,+X)
  1.  . S EXAM("encounterName")=$$NAME^VPRDJ04(+X)
  1.  S ID3=DFN_U_$TR(ID,"-","^") D EN3^RAO7PC1(ID3) D  ;get additional values
  1.  . S X=+$G(^TMP($J,"RAE2",DFN,+$P(ID3,U,3),PROC,"P")) Q:'X
  1.  . S EXAM("providers",1,"providerUid")=$$SETUID^VPRUTILS("user",,X)
  1.  . S EXAM("providers",1,"providerName")=$P($G(^VA(200,X,0)),U),N=0
  1.  . F  S N=$O(^TMP($J,"RAE2",DFN,+$P(ID3,U,3),PROC,"D",N)) Q:N<1  S X=$G(^(N)) D
  1.  .. S EXAM("diagnosis",N,"code")=X
  1.  .. S:N=1 EXAM("diagnosis",N,"primary")="true"
  1.  .. N EXP S EXP=$$LEX(X) S:EXP EXAM("diagnosis",N,"lexicon")=X
  1.  . K ^TMP($J,"RAE2",DFN)
  1.  S EXAM("kind")="Imaging"
  1.  D ADD^VPRDJ("EXAM","image")
  1.  Q
  1.  ;
  1. LEX(X) ; -- Return Lexicon ptr for a Dx Code
  1.  N X,Y,DIC,LEX
  1.  S DIC=78.3,DIC(0)="BFOXZ" D ^DIC
  1.  S LEX=$P($G(Y(0)),U,6)
  1.  Q LEX
  1.  ;
  1. SR1(ID) ; -- surgery
  1.  N SURG,VPRX,VPRY,X,Y,I
  1.  D ONE^SROESTV("VPRY",ID) S VPRX=$G(VPRY(ID)) Q:VPRX=""
  1.  S SURG("localId")=ID,SURG("uid")=$$SETUID^VPRUTILS("surgery",DFN,ID)
  1.  S X=$P(VPRX,U,2),SURG("statusName")="COMPLETED"
  1.  I X?1"* Aborted * ".E S X=$E(X,13,999),SURG("statusName")="ABORTED"
  1.  S (SURG("typeName"),SURG("summary"))=X
  1.  S SURG("dateTime")=$$JSONDT^VPRUTILS($P(VPRX,U,3))
  1.  S X=$P(VPRX,U,4) I X D
  1.  . S SURG("providers",1,"providerUid")=$$SETUID^VPRUTILS("user",,+X)
  1.  . S SURG("providers",1,"providerName")=$P(X,";",2)
  1.  S X=$$GET1^DIQ(130,ID_",",50,"I"),X=$$FAC^VPRD(X)
  1.  D FACILITY^VPRUTILS(X,"SURG")
  1.  S X=$$GET1^DIQ(130,ID_",",.015,"I") I X D
  1.  . S SURG("encounterUid")=$$SETUID^VPRUTILS("visit",DFN,+X)
  1.  . S SURG("encounterName")=$$NAME^VPRDJ04(+X)
  1.  S X=$$GET1^DIQ(136,ID_",",.02,"I") I X D
  1.  . S X=$$CPT^VPRDSR(X)
  1.  . S (SURG("typeName"),SURG("summary"))=$P(X,U,2)
  1.  . S SURG("typeCode")=$$SETNCS^VPRUTILS("cpt",+X)
  1.  S I=0 F  S I=$O(VPRY(ID,I)) Q:I<1  S X=$G(VPRY(ID,I)) I X D
  1.  . N LT,NT S LT=$P(X,U,2) Q:$P(LT," ")="Addendum"
  1.  . S NT=$$GET1^DIQ(8925,+X_",",".01:1501")
  1.  . S SURG("results",I,"uid")=$$SETUID^VPRUTILS("document",DFN,+X)
  1.  . S SURG("results",I,"localTitle")=LT
  1.  . S:$L(NT) SURG("results",I,"nationalTitle")=NT
  1.  S SURG("kind")="Surgery",SURG("category")="SR"
  1.  K ^TMP("TIULIST",$J)
  1.  D ADD^VPRDJ("SURG","surgery")
  1.  Q