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

RAO7PC2.m

Go to the documentation of this file. 
  1. RAO7PC2 ;HISC/GJC-Part two for Return Narrative (EN3^RAO7PC1) ;8/18/08  09:47
  1.  ;;5.0;Radiology/Nuclear Medicine;**1,11,14,16,22,27,45,75,56,95,97**;Mar 16, 1998;Build 6
  1.  ;Supported IA #1571 ^LEX(757.01
  1.  ;Supported IA #10104 UP^XLFSTR
  1.  ;Supported IA #2055 EXTERNAL^DILFD
  1.  ;Supported IA #10060 ^VA(200
  1. CASE(Y) ; Retrieve exam data for specified inverse exam date range.
  1.  ; 'Y'-> Exam node IEN
  1.  N RABNOR,RACNT,RAEXAM,RAI,RAIMPRES,RAINCLUD,RAOPRC,RAORD,RAPDIAG
  1.  N RAPIST,RAPIRE,RAPROC,RARDE,RADTI,RACNI,RADUPHX,RAREASDY
  1.  N RARPT,RARPTST,RARPTXT,RASBN,RASDIAG,RAVER,RAERRFLG,Z,Z1,Z2,RATMP
  1.  S RACNT=1
  1.  S RAEXAM(0)=$G(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,0)) Q:RAEXAM(0)']""
  1.  S:$P(RAEXAM(0),"^",25)=2 RAPSET=1
  1.  S:RAPSET=1 ^TMP($J,"RAE2",RADFN,"PRINT_SET")="" ; xam set with same rpt
  1.  S RAPROC(0)=$G(^RAMIS(71,+$P(RAEXAM(0),"^",2),0))
  1.  S RAPROC=$S($P(RAPROC(0),"^")]"":$P(RAPROC(0),"^"),1:"Unknown")
  1.  S RAORD(0)=$G(^RAO(75.1,+$P(RAEXAM(0),"^",11),0))
  1.  S RAORD(7)=$P(RAORD(0),"^",7) ; CPRS order ien
  1.  S RAREASDY=$P($G(^RAO(75.1,+$P(RAEXAM(0),"^",11),.1)),"^") ;REASON FOR STUDY
  1.  S RAOPRC(0)=$G(^RAMIS(71,+$P(RAORD(0),"^",2),0))
  1.  S RAOPRC=$S($P(RAOPRC(0),"^")]"":$P(RAOPRC(0),"^"),1:"Unknown")
  1.  S RAPDIAG(0)=$G(^RA(78.3,+$P(RAEXAM(0),"^",13),0))
  1.  S RATMP=$$GET1^DIQ(757.01,$P($G(^RA(78.3,+$P(RAEXAM(0),U,13),0)),U,6),.01)
  1.  S RAPDIAG=$P(RAPDIAG(0),"^")_$S(RATMP="":"",1:" ("_RATMP_")")
  1.  S RARPT=+$P(RAEXAM(0),"^",17)
  1.  ; RARPTST="NO REPORT" if no ^RARPT(ien) OR no data for Report Status
  1.  S RARPT(0)=$G(^RARPT(RARPT,0)),RARPTST=$$UL^RAO7PC1A($$RSTAT^RAO7PC1A())
  1.  ; set the following flag variable: RAINCLUD
  1.  ; RAINCLUD=1 includes V, R, EF <-- patch 95
  1.  S RAINCLUD=$S("RVE"[$E(RARPTST):1,1:0)
  1.  I $E(RARPTST)="V",(RAPSET'<0) D
  1.  . S RAVER=$P(RARPT(0),"^",9),RASBN=$P($G(^VA(200,+RAVER,20)),"^",2)
  1.  . S ^TMP($J,"RAE2",RADFN,Y,RAPROC,"V")=RAVER_"^"_RASBN
  1.  . Q
  1.  S RABNOR=$$UP^XLFSTR($P(RAPDIAG(0),"^",4)) S:RABNOR'="Y" RABNOR=""
  1.  I RAPDIAG]"",(RAINCLUD),(RAPSET'<0) D  ; if diag & verif'd or released/unverif'd & first pass if part of xam set (many xams - one rpt)
  1.  . S ^TMP($J,"RAE2",RADFN,Y,RAPROC,"D",RACNT)=RAPDIAG
  1.  . Q
  1.  S ^TMP($J,"RAE2",RADFN,Y,RAPROC,"RFS")=RAREASDY ;REASON FOR STUDY
  1.  ; 1st, get clnhist from file70. 2nd, get addl clnhist form file74
  1.  ; 1st:
  1.  I +$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"H",0)) D
  1.  . N RAI S (RAI,Z)=0
  1.  . F  S Z=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"H",Z)) Q:Z'>0  D
  1.  .. S RAI=RAI+1
  1.  .. S ^TMP($J,"RAE2",RADFN,Y,RAPROC,"H",RAI)=$G(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"H",Z,0))
  1.  .. Q
  1.  . Q
  1.  ;2nd:
  1.  S RADTI=RAINVXDT,RACNI=Y D CHKDUPHX^RART1 ;chk if file74 clnhist is dupl
  1.  I 'RADUPHX,$O(^RARPT(RARPT,"H",0)) S Z="H" D RPTXT(RARPT,Z)
  1.  ;
  1.  I +$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"M",0)) D  ; save modifiers
  1.  . N RAI S (RAI,Z)=0
  1.  . F  S Z=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"M",Z)) Q:Z'>0  D
  1.  .. S RAI=RAI+1
  1.  .. S ^TMP($J,"RAE2",RADFN,Y,RAPROC,"M",RAI)=$P($G(^RAMIS(71.2,+$G(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"M",Z,0)),0)),"^")
  1.  .. Q
  1.  . Q
  1.  I +$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"DX",0)),(RAPSET'<0) D
  1.  . S Z=0 F  S Z=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"DX",Z)) Q:Z'>0  D
  1.  .. S RASDIAG=+$G(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"DX",Z,0))
  1.  .. S RASDIAG(0)=$G(^RA(78.3,RASDIAG,0))
  1.  .. S RATMP=$$GET1^DIQ(757.01,$P($G(^RA(78.3,+RASDIAG,0)),U,6),.01)
  1.  .. S RASDIAG(1)=$P(RASDIAG(0),"^")_$S(RATMP="":"",1:" ("_RATMP_")")
  1.  .. I RASDIAG(1)]"",(RAINCLUD) D
  1.  ... S RACNT=RACNT+1,^TMP($J,"RAE2",RADFN,Y,RAPROC,"D",RACNT)=RASDIAG(1)
  1.  ... I RABNOR'="Y" D
  1.  .... S RABNOR=$$UP^XLFSTR($P(RASDIAG(0),"^",4)) S:RABNOR'="Y" RABNOR=""
  1.  .... Q
  1.  ... Q
  1.  .. Q
  1.  . Q
  1.  I RAINCLUD,(RAPSET'<0) D
  1.  . I +$O(^RARPT(RARPT,"I",0)) S Z="I" D RPTXT(RARPT,Z)
  1.  . I +$O(^RARPT(RARPT,"R",0)) S Z="R" D RPTXT(RARPT,Z)
  1.  . Q
  1.  I $P(RAEXAM(0),"^",25) S ^TMP($J,"RAE2",RADFN,"ORD")=RAOPRC
  1.  I '$P(RAEXAM(0),"^",25) S ^TMP($J,"RAE2",RADFN,"ORD",Y)=RAOPRC
  1.  ;
  1.  ; Check to see if amended report
  1.  I RAPSET'<0,+$O(^RARPT(RARPT,"ERR",0)) S RAERRFLG="A"
  1.  ;
  1.  S:RAPSET'<0 ^TMP($J,"RAE2",RADFN,Y,RAPROC)=RARPTST_"^"_$G(RABNOR)_"^"_$G(RAORD(7))_"^"_$G(RAERRFLG)
  1.  S:RAPSET<0 ^TMP($J,"RAE2",RADFN,Y,RAPROC)=""
  1.  S:RAPSET=1 RAPSET=-1
  1.  ;
  1.  I RARPTST'="No Report" D
  1.  .; Add Prim Int Staff, Prim Int Resident & Reported Date
  1.  .S RAPIST=$P(RAEXAM(0),"^",15)
  1.  .S RAPIRE=$P(RAEXAM(0),"^",12)
  1.  .S RARDE=$P(RARPT(0),"^",8)
  1.  .S ^TMP($J,"RAE2",RADFN,Y,RAPROC,"P")=RAPIST_"^"_RAPIRE_"^"_RARDE
  1.  ;If contrast media was involved in the exam pass that information.
  1.  I +$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"CM",0)) S (RACNT,RAI)=0 D
  1.  .F  S RAI=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"CM",RAI)) Q:'RAI  D
  1.  ..S RACNT=RACNT+1
  1.  ..S RAI(0)=$G(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"CM",RAI,0))
  1.  ..S ^TMP($J,"RAE2",RADFN,Y,RAPROC,"CM",RACNT)=$P(RAI(0),U)_"^"_$$EXTERNAL^DILFD(70.3225,.01,"",$P(RAI(0),U))
  1.  ..Q
  1.  Q
  1.  ;
  1. RPTXT(RARPT,Z) ; Retrieve report text & store in ^TMP
  1.  ; 'RARPT' -> Report IEN
  1.  ; 'Z'     -> "I":Impression Text <> "R":Report Text
  1.  S (Z1,Z2)=0
  1.  ;file 74's "H" nodes are now additional clinical history
  1.  I Z="H" S Z2=$O(^TMP($J,"RAE2",RADFN,Y,RAPROC,Z,""),-1) I $O(^RARPT(RARPT,Z,Z1)) S Z2=Z2+1,^TMP($J,"RAE2",RADFN,Y,RAPROC,Z,Z2)="Additional Clinical History:"
  1.  F  S Z1=$O(^RARPT(RARPT,Z,Z1)) Q:Z1'>0  D
  1.  . S Z1(0)=$G(^RARPT(RARPT,Z,Z1,0)),Z2=Z2+1
  1.  . S ^TMP($J,"RAE2",RADFN,Y,RAPROC,Z,Z2)=Z1(0)
  1.  . Q
  1.  Q
  1.  ;
  1. CLIN(DFN,PROCLIST) ;Radiology and Clinical Reminders API
  1.  ;
  1.  ; Created by Cameron Taylor March 1999
  1.  ; 
  1.  ; This API recieves a patient and a list of procedures. For each 
  1.  ; Procedure, the details of the last 'complete' procedure and/or the
  1.  ; last 'cancelled' & 'in progress' procedure details and returns them 
  1.  ; in ^TMP($J,"RADPROC"
  1.  N XX,PROC,DATE,STATUS,PROVIDER,EXAM,X,Y,EXAMIEN,RADPTIEN,ORDER,SUCCESS
  1.  ; 
  1.  S DFN=$G(DFN)  ; Patient Name
  1.  S PROCLIST=$G(PROCLIST)  ; List of Procedures (separated by '^')
  1.  K ^TMP($J,"RADPROC")
  1.  ;
  1.  S RADPTIEN=$O(^RADPT("B",DFN,""))
  1.  I (RADPTIEN="")!(RADPTIEN=0) D  Q
  1.  .S ^TMP($J,"RADPROC")="Invalid/Unknown Radiology Patient"
  1.  ;
  1.  F XX=1:1 S PROC=$P(PROCLIST,U,XX) Q:PROC=""  D
  1.  .S SUCCESS=0  ; Quit searching if SUCCESS=3 (comp, canc & in prog)
  1.  .S DATE=0 F  S DATE=$O(^RADPT(RADPTIEN,"DT",DATE)) Q:DATE'?7N1".".N!(SUCCESS=3)  D
  1.  ..S EXAMIEN=0 F  S EXAMIEN=$O(^RADPT(RADPTIEN,"DT",DATE,"P",EXAMIEN)) Q:'EXAMIEN!(SUCCESS=3)  D
  1.  ...S EXAM=$G(^RADPT(RADPTIEN,"DT",DATE,"P",EXAMIEN,0))
  1.  ...Q:$P(EXAM,U,2)'=PROC
  1.  ...;
  1.  ...; Continue, get STATUS and ORDER 
  1.  ...; (0 is cancelled, 1-8 in progress & 9 is COMPLETE)
  1.  ...; (ignore if null)
  1.  ...;
  1.  ...S STATUS=$P(EXAM,U,3)
  1.  ...I STATUS'="" D
  1.  ....S ORDER=$P(^RA(72,STATUS,0),U,3)
  1.  ....S STATUS=$P(^RA(72,STATUS,0),U) ; description
  1.  ...; 
  1.  ...; Only one of each type (ORDER)
  1.  ...;
  1.  ...Q:ORDER=""
  1.  ...I ORDER=0 Q:$D(^TMP($J,"RADPROC",RADPTIEN,PROC,"CANCELLED"))  S ORDER="CANCELLED"
  1.  ...I ORDER=9 Q:$D(^TMP($J,"RADPROC",RADPTIEN,PROC,"COMPLETE"))  S ORDER="COMPLETE"
  1.  ...I ORDER<9,ORDER>0 Q:$D(^TMP($J,"RADPROC",RADPTIEN,PROC,"IN PROGRESS"))  S ORDER="IN PROGRESS"
  1.  ...;
  1.  ...; Now for the PROVIDER. Check PRIMARY INTERPRETING STAFF 
  1.  ...; if none, then default to PRIMARY INTERPRETING RESIDENT.
  1.  ...;
  1.  ...S PROVIDER=$P(EXAM,U,15)
  1.  ...S:PROVIDER="" PROVIDER=$P(EXAM,U,12)
  1.  ...S:PROVIDER'="" PROVIDER=$P($G(^VA(200,PROVIDER,0)),U,1) ; description
  1.  ...;
  1.  ...; Create return info. on ^TMP (1st manipulate DATE)
  1.  ...;
  1.  ...S Y=9999999.9999-DATE
  1.  ...S ^TMP($J,"RADPROC",RADPTIEN,PROC,ORDER)=Y_U_STATUS_U_PROVIDER
  1.  ...S SUCCESS=SUCCESS+1
  1.  .;
  1.  .; Finished searching Patient file. Any Procedures with no activity?
  1.  .;
  1.  .I '$D(^TMP($J,"RADPROC",RADPTIEN,PROC)) S ^TMP($J,"RADPROC",RADPTIEN,PROC,"NONE")=""
  1.  Q
  1.  ;