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