RASYNCHLU ;HISC/GJC-Case Number Lookup Synch Logic ; Mar 24, 2023@13:19:45
;;5.0;Radiology/Nuclear Medicine;**198**;Mar 16, 1998;Build 1
;
;Routine File IA Type
;----------------------------------------------
; 100 6475 (C)
;
EN ;Entry point for 'Synch Canceled/Completed Exams with CPRS & RIS Orders'
;note: RADFN is defined after successfully selecting a radiology patient record from ^RADPA
;Returns: RAQS the user selection (globally scoped local)
;
I '$D(RADFN)#2 W !!?2,"Patient information is missing, exiting the option." QUIT
N RABS5,RACEXST,RACPRS,RADATE,RADIV,RADTPRT,RAEXDT,RAEXST,RAHDFLG,RAHDR,RAI,RAII,RAIMAGE
N RAOIFN,RAORIFN,RAORSTS,RAPRC,RAPTNAME,RAREQST,RAROOT,RASSN,RAX,RAY2,RAY3,RAXIT
S (RAHDFLG,RACNT,RAXIT)=0,RAHDR="<<<< Synch Exams with CPRS/Radiology Orders >>>>"
D SEL Q:$O(^TMP($J,"RASYNCH",0))'>0
;now display the existing data
S RAI=0,RAROOT=$NA(^TMP($J,"RASYNCH"))
F S RAI=$O(@RAROOT@(RAI)) Q:RAI'>0 D Q:RAXIT>0!(RAQS>0)
.S RAX=$G(@RAROOT@(RAI))
.F RAII=1:1:7 S @$P("RADFN^RADTI^RADTE^RACNI^RACN^RAOIFN^RAACC","^",RAII)=$P(RAX,"^",RAII)
.D SETUP,DATA
.Q
Q
;
SEL ; selection criteria part one
Q:'$D(^DPT(RADFN,0))#2 S RADFN(0)=$G(^DPT(RADFN,0)),RASSN=$$SSN^RAUTL,RAPTNAME=$P(RADFN(0),"^")
D HOME^%ZIS S (RACNT,RADTI,RAQS)=0
F S RADTI=$O(^RADPT(RADFN,"DT",RADTI)) Q:RADTI'>0 D Q:RAQS>0!(RAXIT>0)
.S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)),RADTE=+$P(RAY2,U) D SEL2
.Q
Q
;
SEL2 ; selection criteria part two
S RADIV=+$P(RAY2,U,3),RAIMAGE=+$P(RAY2,U,2)
S RADIV=+$G(^RA(79,RADIV,0)),RADIV=$P($G(^DIC(4,RADIV,0)),U)
S:RADIV']"" RADIV="Unknown"
S RAIMAGE=$P($G(^RA(79.2,RAIMAGE,0)),U)
S:RAIMAGE']"" RAIMAGE="Unknown" S RACNI=0
F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0 D Q:RAQS>0!(RAXIT>0)
.S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) S RACN=+$P(RAY3,U)
.D SAVE
.QUIT
Q
SAVE ; Screen only if entered through Rad/Nuc Med must be canceled/completed exams (determined by order #)
S RAEXST=+$P(RAY3,U,3),RAEXST(0)=$G(^RA(72,RAEXST,0))
Q:RAEXST(0)="" S RAEXST(1)=$P(RAEXST(0),U)
;quit if exam is not canceled or not complete
I $P(RAEXST(0),U,3)'=0,($P(RAEXST(0),U,3)'=9) Q
S RACN=$P(RAY3,U) S:RACN="" RACN="error"
S RAEXDT=$E(RADTE,4,5)_"/"_$E(RADTE,6,7)_"/"_$E(RADTE,2,3)
S RAPRC(0)=$G(^RAMIS(71,+$P(RAY3,U,2),0)),RAPRC=$P(RAPRC(0),U)
S RAOIFN=+$P(RAY3,U,11),RAOIFN(0)=$G(^RAO(75.1,RAOIFN,0))
;
;we do not care what the RIS order status is; we only care that the CPRS order
;status is 'ACTIVE'. Get RIS request status name, check CPRS order to see if active.
S RAREQST=$$GET1^DIQ(75.1,RAOIFN_",",5) ;RIS external
S RAORIFN=+$P(RAOIFN(0),U,7) ;CPRS ptr to file #100
S RAORSTS=$$GET1^DIQ(100,RAORIFN_",",5) ;CPRS external
Q:RAORSTS'="ACTIVE" ;CPRS order must be ACTIVE
;
;check our active order to see if there are other non-canceled exams tied to it
;if true do not discontinue the orders; else discontinue the order(s)
;
I $P(RAEXST(0),U,3)=0 Q:$$OTHERS(RAOIFN,RADFN)
;
;-- accession #
I $P(RAY3,U,31)'="" S RAACC=$P(RAY3,U,31)
E S RAACC=$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_RACN
;--
S (RADTPRT,Y)=RADTE D D^RAUTL S RADATE=Y,RACNT=RACNT+1
S ^TMP($J,"RASYNCH",RACNT)=RADFN_U_RADTI_U_RADTE_U_RACNI_U_RACN_U_RAOIFN_U_RAACC
Q
;
DATA ;display data here
;RAROOT = $NA(^TMP($J,"RASYNCH",RACNT))
D:RAHDFLG=0 HD ;mimics 'Case No. Exam Edit' & 'Edit Exam by Patient' options screen display
;
S RACEXST=$P($G(^RA(72,+$P(RAY3,U,3),0)),U)
W !,RAI,?4,RAACC,?21,$E(RAPRC,1,17),?41,RAEXDT,?52,$E(RACEXST,1,9),?62,RAORIFN
;condition: if at end of screen check and more patient data stop and ask user for a selection
;the user can enter return at the selection prompt (RAQS=0) move to next set of data
I (($Y+4)>IOSL) D
.D USRSEL Q:RAXIT>0!(RAQS>0)
.W:$O(@RAROOT@(RAI))>0 @IOF
.Q
;condition: if not at end of screen and no more patient data ask user for their choice
E D:$O(@RAROOT@(RAI))'>0 USRSEL
Q
;
HD ;print header once
S RAHDFLG=1,RABS5=" ("_$E(RAPTNAME,1)_$P(RASSN,"-",3)_")"
W @IOF,?25,RAHDR,!!,"Patient's Name: ",$E(RAPTNAME,1,20),RABS5,?59,"Run Date: " S Y=DT D DT^DIO2
W !!,$$CJ^XLFSTR("========== Synch Exams with CPRS/Radiology Orders ==========",IOM)
W !!?4,"Accession #",?21,"Procedure",?41,"Exam DT",?52,"Exam ST",?62,"CPRS Order #"
W !?4,"-----------",?21,"---------",?41,"-------",?52,"-------",?62,"------------" Q
Q
;
USRSEL ;prompt user for selection.
;Input : RACNT = # of records displayed
;Output: RAQS = the # (between 1 & RACNT) of user's selection
N DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,Y
S DIR(0)="NO^1:"_RAI_":0",DIR("A")="Enter your numeric selection"
S DIR("?",1)="Enter the number identifying the accession number of the exam to"
S DIR("?",2)="be re-synchronized. Only one exam can be re-synchronized at a time."
S DIR("?")="Enter a number between 1 and "_RAI_"." D ^DIR
I $D(DTOUT)#2!($D(DUOUT)#2)!($D(DIROUT)#2) S RAXIT=1 QUIT
S RAQS=+Y
QUIT
;
SETUP ;setup basic exam and order data.
S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)) Q:RAY2=""
S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) Q:RAY3=""
S RAPRC(0)=$G(^RAMIS(71,+$P(RAY3,U,2),0)),RAPRC=$P(RAPRC(0),U)
S RAEXDT=$E(RADTE,4,5)_"/"_$E(RADTE,6,7)_"/"_$E(RADTE,2,3)
S RAOIFN=+$P(RAY3,U,11),RAOIFN(0)=$G(^RAO(75.1,RAOIFN,0))
S RAREQST=$$GET1^DIQ(75.1,RAOIFN_",",5) ;RIS external
S RAORIFN=+$P(RAOIFN(0),U,7) ;CPRS ptr to file #100
S RAORSTS=$$GET1^DIQ(100,RAORIFN_",",5) ;CPRS external
QUIT
;
OTHERS(RAOIFN,RADFN) ;are there other non-canceled exams tied
;to this order?
; Input: RAOIFN = RIS order IEN
; RADFN = DFN of patient
;
; returns: RAR: 1 if another non-canceled exam is tied to the RIS order
; else 0 (the default)
N RA0,RA1,RA72,RAA,RAC,RAQ,RAR S (RA1,RAR)=0
F S RA1=$O(^RADPT("AO",RAOIFN,RADFN,RA1)) Q:RA1'>0 D Q:RAR
.S RA0=0 F S RA0=$O(^RADPT("AO",RAOIFN,RADFN,RA1,RA0)) Q:RA0'>0 D Q:RAR
..S RAQ=$G(^RADPT(RADFN,"DT",RA1,"P",RA0,0)) Q:RAQ="" ;bad data
..S RA72=+$P(RAQ,U,3),RA72(0)=$G(^RA(72,RA72,0))
..S:$P(RA72(0),U,3)>0 RAR=1
..Q
.Q
Q RAR
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRASYNCHLU 6224 printed Apr 09, 2024@21:37:49 Page 2
RASYNCHLU ;HISC/GJC-Case Number Lookup Synch Logic ; Mar 24, 2023@13:19:45
+1 ;;5.0;Radiology/Nuclear Medicine;**198**;Mar 16, 1998;Build 1
+2 ;
+3 ;Routine File IA Type
+4 ;----------------------------------------------
+5 ; 100 6475 (C)
+6 ;
EN ;Entry point for 'Synch Canceled/Completed Exams with CPRS & RIS Orders'
+1 ;note: RADFN is defined after successfully selecting a radiology patient record from ^RADPA
+2 ;Returns: RAQS the user selection (globally scoped local)
+3 ;
+4 IF '$DATA(RADFN)#2
WRITE !!?2,"Patient information is missing, exiting the option."
QUIT
+5 NEW RABS5,RACEXST,RACPRS,RADATE,RADIV,RADTPRT,RAEXDT,RAEXST,RAHDFLG,RAHDR,RAI,RAII,RAIMAGE
+6 NEW RAOIFN,RAORIFN,RAORSTS,RAPRC,RAPTNAME,RAREQST,RAROOT,RASSN,RAX,RAY2,RAY3,RAXIT
+7 SET (RAHDFLG,RACNT,RAXIT)=0
SET RAHDR="<<<< Synch Exams with CPRS/Radiology Orders >>>>"
+8 DO SEL
if $ORDER(^TMP($JOB,"RASYNCH",0))'>0
QUIT
+9 ;now display the existing data
+10 SET RAI=0
SET RAROOT=$NAME(^TMP($JOB,"RASYNCH"))
+11 FOR
SET RAI=$ORDER(@RAROOT@(RAI))
if RAI'>0
QUIT
Begin DoDot:1
+12 SET RAX=$GET(@RAROOT@(RAI))
+13 FOR RAII=1:1:7
SET @$PIECE("RADFN^RADTI^RADTE^RACNI^RACN^RAOIFN^RAACC","^",RAII)=$PIECE(RAX,"^",RAII)
+14 DO SETUP
DO DATA
+15 QUIT
End DoDot:1
if RAXIT>0!(RAQS>0)
QUIT
+16 QUIT
+17 ;
SEL ; selection criteria part one
+1 if '$DATA(^DPT(RADFN,0))#2
QUIT
SET RADFN(0)=$GET(^DPT(RADFN,0))
SET RASSN=$$SSN^RAUTL
SET RAPTNAME=$PIECE(RADFN(0),"^")
+2 DO HOME^%ZIS
SET (RACNT,RADTI,RAQS)=0
+3 FOR
SET RADTI=$ORDER(^RADPT(RADFN,"DT",RADTI))
if RADTI'>0
QUIT
Begin DoDot:1
+4 SET RAY2=$GET(^RADPT(RADFN,"DT",RADTI,0))
SET RADTE=+$PIECE(RAY2,U)
DO SEL2
+5 QUIT
End DoDot:1
if RAQS>0!(RAXIT>0)
QUIT
+6 QUIT
+7 ;
SEL2 ; selection criteria part two
+1 SET RADIV=+$PIECE(RAY2,U,3)
SET RAIMAGE=+$PIECE(RAY2,U,2)
+2 SET RADIV=+$GET(^RA(79,RADIV,0))
SET RADIV=$PIECE($GET(^DIC(4,RADIV,0)),U)
+3 if RADIV']""
SET RADIV="Unknown"
+4 SET RAIMAGE=$PIECE($GET(^RA(79.2,RAIMAGE,0)),U)
+5 if RAIMAGE']""
SET RAIMAGE="Unknown"
SET RACNI=0
+6 FOR
SET RACNI=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI))
if RACNI'>0
QUIT
Begin DoDot:1
+7 SET RAY3=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
SET RACN=+$PIECE(RAY3,U)
+8 DO SAVE
+9 QUIT
End DoDot:1
if RAQS>0!(RAXIT>0)
QUIT
+10 QUIT
SAVE ; Screen only if entered through Rad/Nuc Med must be canceled/completed exams (determined by order #)
+1 SET RAEXST=+$PIECE(RAY3,U,3)
SET RAEXST(0)=$GET(^RA(72,RAEXST,0))
+2 if RAEXST(0)=""
QUIT
SET RAEXST(1)=$PIECE(RAEXST(0),U)
+3 ;quit if exam is not canceled or not complete
+4 IF $PIECE(RAEXST(0),U,3)'=0
IF ($PIECE(RAEXST(0),U,3)'=9)
QUIT
+5 SET RACN=$PIECE(RAY3,U)
if RACN=""
SET RACN="error"
+6 SET RAEXDT=$EXTRACT(RADTE,4,5)_"/"_$EXTRACT(RADTE,6,7)_"/"_$EXTRACT(RADTE,2,3)
+7 SET RAPRC(0)=$GET(^RAMIS(71,+$PIECE(RAY3,U,2),0))
SET RAPRC=$PIECE(RAPRC(0),U)
+8 SET RAOIFN=+$PIECE(RAY3,U,11)
SET RAOIFN(0)=$GET(^RAO(75.1,RAOIFN,0))
+9 ;
+10 ;we do not care what the RIS order status is; we only care that the CPRS order
+11 ;status is 'ACTIVE'. Get RIS request status name, check CPRS order to see if active.
+12 ;RIS external
SET RAREQST=$$GET1^DIQ(75.1,RAOIFN_",",5)
+13 ;CPRS ptr to file #100
SET RAORIFN=+$PIECE(RAOIFN(0),U,7)
+14 ;CPRS external
SET RAORSTS=$$GET1^DIQ(100,RAORIFN_",",5)
+15 ;CPRS order must be ACTIVE
if RAORSTS'="ACTIVE"
QUIT
+16 ;
+17 ;check our active order to see if there are other non-canceled exams tied to it
+18 ;if true do not discontinue the orders; else discontinue the order(s)
+19 ;
+20 IF $PIECE(RAEXST(0),U,3)=0
if $$OTHERS(RAOIFN,RADFN)
QUIT
+21 ;
+22 ;-- accession #
+23 IF $PIECE(RAY3,U,31)'=""
SET RAACC=$PIECE(RAY3,U,31)
+24 IF '$TEST
SET RAACC=$EXTRACT(RADTE,4,7)_$EXTRACT(RADTE,2,3)_"-"_RACN
+25 ;--
+26 SET (RADTPRT,Y)=RADTE
DO D^RAUTL
SET RADATE=Y
SET RACNT=RACNT+1
+27 SET ^TMP($JOB,"RASYNCH",RACNT)=RADFN_U_RADTI_U_RADTE_U_RACNI_U_RACN_U_RAOIFN_U_RAACC
+28 QUIT
+29 ;
DATA ;display data here
+1 ;RAROOT = $NA(^TMP($J,"RASYNCH",RACNT))
+2 ;mimics 'Case No. Exam Edit' & 'Edit Exam by Patient' options screen display
if RAHDFLG=0
DO HD
+3 ;
+4 SET RACEXST=$PIECE($GET(^RA(72,+$PIECE(RAY3,U,3),0)),U)
+5 WRITE !,RAI,?4,RAACC,?21,$EXTRACT(RAPRC,1,17),?41,RAEXDT,?52,$EXTRACT(RACEXST,1,9),?62,RAORIFN
+6 ;condition: if at end of screen check and more patient data stop and ask user for a selection
+7 ;the user can enter return at the selection prompt (RAQS=0) move to next set of data
+8 IF (($Y+4)>IOSL)
Begin DoDot:1
+9 DO USRSEL
if RAXIT>0!(RAQS>0)
QUIT
+10 if $ORDER(@RAROOT@(RAI))>0
WRITE @IOF
+11 QUIT
End DoDot:1
+12 ;condition: if not at end of screen and no more patient data ask user for their choice
+13 IF '$TEST
if $ORDER(@RAROOT@(RAI))'>0
DO USRSEL
+14 QUIT
+15 ;
HD ;print header once
+1 SET RAHDFLG=1
SET RABS5=" ("_$EXTRACT(RAPTNAME,1)_$PIECE(RASSN,"-",3)_")"
+2 WRITE @IOF,?25,RAHDR,!!,"Patient's Name: ",$EXTRACT(RAPTNAME,1,20),RABS5,?59,"Run Date: "
SET Y=DT
DO DT^DIO2
+3 WRITE !!,$$CJ^XLFSTR("========== Synch Exams with CPRS/Radiology Orders ==========",IOM)
+4 WRITE !!?4,"Accession #",?21,"Procedure",?41,"Exam DT",?52,"Exam ST",?62,"CPRS Order #"
+5 WRITE !?4,"-----------",?21,"---------",?41,"-------",?52,"-------",?62,"------------"
QUIT
+6 QUIT
+7 ;
USRSEL ;prompt user for selection.
+1 ;Input : RACNT = # of records displayed
+2 ;Output: RAQS = the # (between 1 & RACNT) of user's selection
+3 NEW DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,Y
+4 SET DIR(0)="NO^1:"_RAI_":0"
SET DIR("A")="Enter your numeric selection"
+5 SET DIR("?",1)="Enter the number identifying the accession number of the exam to"
+6 SET DIR("?",2)="be re-synchronized. Only one exam can be re-synchronized at a time."
+7 SET DIR("?")="Enter a number between 1 and "_RAI_"."
DO ^DIR
+8 IF $DATA(DTOUT)#2!($DATA(DUOUT)#2)!($DATA(DIROUT)#2)
SET RAXIT=1
QUIT
+9 SET RAQS=+Y
+10 QUIT
+11 ;
SETUP ;setup basic exam and order data.
+1 SET RAY2=$GET(^RADPT(RADFN,"DT",RADTI,0))
if RAY2=""
QUIT
+2 SET RAY3=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
if RAY3=""
QUIT
+3 SET RAPRC(0)=$GET(^RAMIS(71,+$PIECE(RAY3,U,2),0))
SET RAPRC=$PIECE(RAPRC(0),U)
+4 SET RAEXDT=$EXTRACT(RADTE,4,5)_"/"_$EXTRACT(RADTE,6,7)_"/"_$EXTRACT(RADTE,2,3)
+5 SET RAOIFN=+$PIECE(RAY3,U,11)
SET RAOIFN(0)=$GET(^RAO(75.1,RAOIFN,0))
+6 ;RIS external
SET RAREQST=$$GET1^DIQ(75.1,RAOIFN_",",5)
+7 ;CPRS ptr to file #100
SET RAORIFN=+$PIECE(RAOIFN(0),U,7)
+8 ;CPRS external
SET RAORSTS=$$GET1^DIQ(100,RAORIFN_",",5)
+9 QUIT
+10 ;
OTHERS(RAOIFN,RADFN) ;are there other non-canceled exams tied
+1 ;to this order?
+2 ; Input: RAOIFN = RIS order IEN
+3 ; RADFN = DFN of patient
+4 ;
+5 ; returns: RAR: 1 if another non-canceled exam is tied to the RIS order
+6 ; else 0 (the default)
+7 NEW RA0,RA1,RA72,RAA,RAC,RAQ,RAR
SET (RA1,RAR)=0
+8 FOR
SET RA1=$ORDER(^RADPT("AO",RAOIFN,RADFN,RA1))
if RA1'>0
QUIT
Begin DoDot:1
+9 SET RA0=0
FOR
SET RA0=$ORDER(^RADPT("AO",RAOIFN,RADFN,RA1,RA0))
if RA0'>0
QUIT
Begin DoDot:2
+10 ;bad data
SET RAQ=$GET(^RADPT(RADFN,"DT",RA1,"P",RA0,0))
if RAQ=""
QUIT
+11 SET RA72=+$PIECE(RAQ,U,3)
SET RA72(0)=$GET(^RA(72,RA72,0))
+12 if $PIECE(RA72(0),U,3)>0
SET RAR=1
+13 QUIT
End DoDot:2
if RAR
QUIT
+14 QUIT
End DoDot:1
if RAR
QUIT
+15 QUIT RAR
+16 ;
