- 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 Feb 19, 2025@00:06:16 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 ;