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

RASYNCH.m

Go to the documentation of this file.
  1. RASYNCH ;HISC/GJC - synch orders with studies ; Mar 23, 2023@12:40:15
  1. ;;5.0;Radiology/Nuclear Medicine;**192,198**;Mar 16, 1998;Build 1
  1. ;
  1. ;Routine File IA Type
  1. ;----------------------------------------------
  1. ; 100 6475 (C)
  1. ;
  1. Q
  1. ;
  1. EN ; entry point for option
  1. ;
  1. ;new system level variables do not kill them!
  1. N RAI,RAINDIE,RAQS,RAX,RAXIT S RAQS=0
  1. I '$D(RAMDIV)!('$D(RAMDV))!('$D(RAMLC))!('$D(RAIMGTY)) D
  1. .D SET^RAPSET1 S RAINDIE="" ;option called as stand alone
  1. .Q
  1. I $D(XQUIT) K XQUIT Q
  1. Q:'$D(RAIMGTY)#2 S RAXIT=0
  1. ;
  1. ;// main //
  1. ;ask the user for the case number, find accession, synch
  1. F D PAT Q:RAXIT="^"
  1. QUIT
  1. ;// end main //
  1. ;
  1. ;// begin PAT //
  1. PAT ;get patient DFN move forward
  1. ; Note: if user timed out or entered null var 'X'
  1. ; is set to a caret
  1. K ^TMP($J,"RASYNCH")
  1. S DIC(0)="AEMQ" D ^RADPA
  1. I +Y<0 S RAXIT="^"
  1. I RAXIT="^" D EXIT QUIT
  1. S RADFN=+Y
  1. ;
  1. D EN^RASYNCHLU ;RAQS is initialized, updated but not killed in RASYNCHLU
  1. I RAQS=0 D D EXIT QUIT
  1. .I RACNT=0 W !!,"Completed/Canceled exams are not associated with an active CPRS order.",!
  1. .E I RAQS=0 W !!,"An exam for this patient was not selected.",! ;out of sych exams yes, but none selected
  1. .Q
  1. S RAX=$G(^TMP($J,"RASYNCH",RAQS))
  1. F RAI=1:1:7 S @$P("RADFN^RADTI^RADTE^RACNI^RACN^RAOIFN^RAACC","^",RAI)=$P(RAX,"^",RAI)
  1. ;
  1. S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0))
  1. S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
  1. I RAY2=""!(RAY3="") Q
  1. ;
  1. S RAOIFN=$P(RAY3,U,11),RAXSTS=+$P(RAY3,U,3)
  1. S RAOIFN(0)=$G(^RAO(75.1,RAOIFN,0)),RAORIFN=+$P(RAOIFN(0),U,7)
  1. S RAXSTS(0)=$G(^RA(72,RAXSTS,0)),RAORDNUM=$P(RAXSTS(0),U,3)
  1. ;exam must be canceled or completed to continue
  1. I RAORDNUM'=0,(RAORDNUM'=9) Q
  1. ;if exam canceled check the order reason if there use it.
  1. ; if order reason is not there check the canceled reason for the exam
  1. ; if canceled reason is missing default to "EXAM CANCELLED"
  1. I RAORDNUM=0 D
  1. .S RAOREA=$P(RAOIFN(0),U,10) ;#10 REASON
  1. .S:RAOREA="" RAOREA=$P(RAY3,U,23) ;note RAOREA will be an IEN
  1. .S:RAOREA="" RAOREA=$$FIND1^DIC(75.2,,"B","EXAM CANCELLED")
  1. .Q
  1. ;
  1. ;$$ASK() returns 1 (synch); 0 (no synch); -1 (timeout/caret(s) entered)
  1. D:$$ASK()=1 SYNCH
  1. ;
  1. EXIT ;cleanup and exit the option
  1. K %,%DT,C,DIC,DPTDFN,DTOUT,DUOUT,ORSTS,RAORIFN,RAORSTS,RACN,RACNI,RACNT,RAADC,RAADC1,RADFN,RADTE,RADTI
  1. K RAACC,RAHEAD,RAI,RANME,RAOIFN,RAORDNUM,RAOREA,RASSN,RAXSTS,RAY2,RAY3,X,Y,^TMP($J,"RASYNCH")
  1. D:$D(RAINDIE)#2 KILL^RAPSET1 ;run as a standalone option...
  1. QUIT
  1. ;// end CASE //
  1. ;
  1. ASK() ;Display the accession number for the study. Ask (yes/no) the user if they want
  1. ;to synch up active orders for this completed study.
  1. ;returns: 1 (synch); 0 (no synch); -1 (timeout/caret(s) entered)
  1. ;
  1. W !!,"The accession number tied to this case is: '"_RAACC_"'."
  1. ;Check this accession if part of a set.
  1. ;If yes, is there an active descendent?
  1. ;If yes (1), do not update. Else (0) ask to proceed.
  1. I $P(RAY3,U,25)>0 I $$SET()>0 D Q -1
  1. .W !,"'"_RAACC_"' is part of a set that has other associated active"
  1. .W !,"descendents. The order cannot be updated at this time."
  1. .Q
  1. N RAYN K %,DIR,X,Y,DTOUT,DIROUT,DIRUT,DUOUT
  1. S DIR("A")="Would you like to proceed? ",DIR("B")="Yes"
  1. S DIR("?",1)="Enter 'Yes' to update the RIS & CPRS orders to COMPLETE or 'No' to"
  1. S DIR("?")="exit the option without updating the RIS & CPRS orders to COMPLETE."
  1. S DIR(0)="YA^" D ^DIR
  1. ;'X' is the user's unprocessed input
  1. ;'Y' is: 1 for 'Yes' & 0 for 'No'
  1. S RAYN=$S($D(DIRUT)#2!($D(DIROUT)#2):-1,1:Y) K %,DIR,X,Y,DTOUT,DIROUT,DIRUT,DUOUT
  1. Q RAYN
  1. ;
  1. SYNCH ;synch the orders for this completed exam.
  1. ;Variables: RAOIFN,RADFN,RADTI,RADTE,RACNI,RACN set in call to RACNLU.
  1. ;RADUZ used in SETLOG^RAORDU; RAORDNUM, RAOREA set above.
  1. N RADUZ,RAOSTS
  1. S RADUZ=DUZ,RAOREA=$G(RAOREA) ;IEN for record in file 75.2
  1. ;update RIS & CPRS orders to canceled (request status code = 1) if exam was canceled (order number = 0)
  1. ;or 'complete' (request status code = 2) if the exam was completed (order number = 9).
  1. S RAOSTS=$S(RAORDNUM=0:1,1:2)
  1. D ^RAORDU
  1. W !!,"Radiology order (IEN: "_RAOIFN_") request status updated to: '"_$$GET1^DIQ(75.1,RAOIFN_",",5,"","")_"'."
  1. W !,"CPRS order (IEN: "_RAORIFN_") status updated to: '"_$$GET1^DIQ(100,RAORIFN_",",5,"","")_"'."
  1. Q
  1. ;
  1. SET() ;check other descendents to see if they're active.
  1. ;Note: RADFN, RADTI, RACNI, RACN are defined at this time.
  1. ;Output: 1 if an active descendent; else 0
  1. N RAF,RAR,RATMP,RAXS S (RAF,RAR)=0 ;assumes RACNI definition
  1. F S RAR=$O(^RADPT(RADFN,"DT",RADTI,"P",RAR)) Q:RAR'>0 D Q:RAF
  1. .S RATMP=$G(^RADPT(RADFN,"DT",RADTI,"P",RAR,0)),RAXS=$G(^RA(72,+$P(RATMP,U,3),0))
  1. .S RAXS(3)=$P(RAXS,U,3) ;order #
  1. .S RAF=RAXS(3)#9 ;is 0 if ord #: missing, 0 or 9
  1. .Q
  1. Q RAF
  1. ;