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

RASYNCHLU.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;Routine File IA Type
  1. ;----------------------------------------------
  1. ; 100 6475 (C)
  1. ;
  1. 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
  1. ;Returns: RAQS the user selection (globally scoped local)
  1. ;
  1. I '$D(RADFN)#2 W !!?2,"Patient information is missing, exiting the option." QUIT
  1. N RABS5,RACEXST,RACPRS,RADATE,RADIV,RADTPRT,RAEXDT,RAEXST,RAHDFLG,RAHDR,RAI,RAII,RAIMAGE
  1. N RAOIFN,RAORIFN,RAORSTS,RAPRC,RAPTNAME,RAREQST,RAROOT,RASSN,RAX,RAY2,RAY3,RAXIT
  1. S (RAHDFLG,RACNT,RAXIT)=0,RAHDR="<<<< Synch Exams with CPRS/Radiology Orders >>>>"
  1. D SEL Q:$O(^TMP($J,"RASYNCH",0))'>0
  1. ;now display the existing data
  1. S RAI=0,RAROOT=$NA(^TMP($J,"RASYNCH"))
  1. F S RAI=$O(@RAROOT@(RAI)) Q:RAI'>0 D Q:RAXIT>0!(RAQS>0)
  1. .S RAX=$G(@RAROOT@(RAI))
  1. .F RAII=1:1:7 S @$P("RADFN^RADTI^RADTE^RACNI^RACN^RAOIFN^RAACC","^",RAII)=$P(RAX,"^",RAII)
  1. .D SETUP,DATA
  1. .Q
  1. Q
  1. ;
  1. SEL ; selection criteria part one
  1. Q:'$D(^DPT(RADFN,0))#2 S RADFN(0)=$G(^DPT(RADFN,0)),RASSN=$$SSN^RAUTL,RAPTNAME=$P(RADFN(0),"^")
  1. D HOME^%ZIS S (RACNT,RADTI,RAQS)=0
  1. F S RADTI=$O(^RADPT(RADFN,"DT",RADTI)) Q:RADTI'>0 D Q:RAQS>0!(RAXIT>0)
  1. .S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)),RADTE=+$P(RAY2,U) D SEL2
  1. .Q
  1. Q
  1. ;
  1. SEL2 ; selection criteria part two
  1. S RADIV=+$P(RAY2,U,3),RAIMAGE=+$P(RAY2,U,2)
  1. S RADIV=+$G(^RA(79,RADIV,0)),RADIV=$P($G(^DIC(4,RADIV,0)),U)
  1. S:RADIV']"" RADIV="Unknown"
  1. S RAIMAGE=$P($G(^RA(79.2,RAIMAGE,0)),U)
  1. S:RAIMAGE']"" RAIMAGE="Unknown" S RACNI=0
  1. F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0 D Q:RAQS>0!(RAXIT>0)
  1. .S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) S RACN=+$P(RAY3,U)
  1. .D SAVE
  1. .QUIT
  1. Q
  1. SAVE ; Screen only if entered through Rad/Nuc Med must be canceled/completed exams (determined by order #)
  1. S RAEXST=+$P(RAY3,U,3),RAEXST(0)=$G(^RA(72,RAEXST,0))
  1. Q:RAEXST(0)="" S RAEXST(1)=$P(RAEXST(0),U)
  1. ;quit if exam is not canceled or not complete
  1. I $P(RAEXST(0),U,3)'=0,($P(RAEXST(0),U,3)'=9) Q
  1. S RACN=$P(RAY3,U) S:RACN="" RACN="error"
  1. S RAEXDT=$E(RADTE,4,5)_"/"_$E(RADTE,6,7)_"/"_$E(RADTE,2,3)
  1. S RAPRC(0)=$G(^RAMIS(71,+$P(RAY3,U,2),0)),RAPRC=$P(RAPRC(0),U)
  1. S RAOIFN=+$P(RAY3,U,11),RAOIFN(0)=$G(^RAO(75.1,RAOIFN,0))
  1. ;
  1. ;we do not care what the RIS order status is; we only care that the CPRS order
  1. ;status is 'ACTIVE'. Get RIS request status name, check CPRS order to see if active.
  1. S RAREQST=$$GET1^DIQ(75.1,RAOIFN_",",5) ;RIS external
  1. S RAORIFN=+$P(RAOIFN(0),U,7) ;CPRS ptr to file #100
  1. S RAORSTS=$$GET1^DIQ(100,RAORIFN_",",5) ;CPRS external
  1. Q:RAORSTS'="ACTIVE" ;CPRS order must be ACTIVE
  1. ;
  1. ;check our active order to see if there are other non-canceled exams tied to it
  1. ;if true do not discontinue the orders; else discontinue the order(s)
  1. ;
  1. I $P(RAEXST(0),U,3)=0 Q:$$OTHERS(RAOIFN,RADFN)
  1. ;
  1. ;-- accession #
  1. I $P(RAY3,U,31)'="" S RAACC=$P(RAY3,U,31)
  1. E S RAACC=$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_RACN
  1. ;--
  1. S (RADTPRT,Y)=RADTE D D^RAUTL S RADATE=Y,RACNT=RACNT+1
  1. S ^TMP($J,"RASYNCH",RACNT)=RADFN_U_RADTI_U_RADTE_U_RACNI_U_RACN_U_RAOIFN_U_RAACC
  1. Q
  1. ;
  1. DATA ;display data here
  1. ;RAROOT = $NA(^TMP($J,"RASYNCH",RACNT))
  1. D:RAHDFLG=0 HD ;mimics 'Case No. Exam Edit' & 'Edit Exam by Patient' options screen display
  1. ;
  1. S RACEXST=$P($G(^RA(72,+$P(RAY3,U,3),0)),U)
  1. W !,RAI,?4,RAACC,?21,$E(RAPRC,1,17),?41,RAEXDT,?52,$E(RACEXST,1,9),?62,RAORIFN
  1. ;condition: if at end of screen check and more patient data stop and ask user for a selection
  1. ;the user can enter return at the selection prompt (RAQS=0) move to next set of data
  1. I (($Y+4)>IOSL) D
  1. .D USRSEL Q:RAXIT>0!(RAQS>0)
  1. .W:$O(@RAROOT@(RAI))>0 @IOF
  1. .Q
  1. ;condition: if not at end of screen and no more patient data ask user for their choice
  1. E D:$O(@RAROOT@(RAI))'>0 USRSEL
  1. Q
  1. ;
  1. HD ;print header once
  1. S RAHDFLG=1,RABS5=" ("_$E(RAPTNAME,1)_$P(RASSN,"-",3)_")"
  1. W @IOF,?25,RAHDR,!!,"Patient's Name: ",$E(RAPTNAME,1,20),RABS5,?59,"Run Date: " S Y=DT D DT^DIO2
  1. W !!,$$CJ^XLFSTR("========== Synch Exams with CPRS/Radiology Orders ==========",IOM)
  1. W !!?4,"Accession #",?21,"Procedure",?41,"Exam DT",?52,"Exam ST",?62,"CPRS Order #"
  1. W !?4,"-----------",?21,"---------",?41,"-------",?52,"-------",?62,"------------" Q
  1. Q
  1. ;
  1. USRSEL ;prompt user for selection.
  1. ;Input : RACNT = # of records displayed
  1. ;Output: RAQS = the # (between 1 & RACNT) of user's selection
  1. N DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,Y
  1. S DIR(0)="NO^1:"_RAI_":0",DIR("A")="Enter your numeric selection"
  1. S DIR("?",1)="Enter the number identifying the accession number of the exam to"
  1. S DIR("?",2)="be re-synchronized. Only one exam can be re-synchronized at a time."
  1. S DIR("?")="Enter a number between 1 and "_RAI_"." D ^DIR
  1. I $D(DTOUT)#2!($D(DUOUT)#2)!($D(DIROUT)#2) S RAXIT=1 QUIT
  1. S RAQS=+Y
  1. QUIT
  1. ;
  1. SETUP ;setup basic exam and order data.
  1. S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)) Q:RAY2=""
  1. S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) Q:RAY3=""
  1. S RAPRC(0)=$G(^RAMIS(71,+$P(RAY3,U,2),0)),RAPRC=$P(RAPRC(0),U)
  1. S RAEXDT=$E(RADTE,4,5)_"/"_$E(RADTE,6,7)_"/"_$E(RADTE,2,3)
  1. S RAOIFN=+$P(RAY3,U,11),RAOIFN(0)=$G(^RAO(75.1,RAOIFN,0))
  1. S RAREQST=$$GET1^DIQ(75.1,RAOIFN_",",5) ;RIS external
  1. S RAORIFN=+$P(RAOIFN(0),U,7) ;CPRS ptr to file #100
  1. S RAORSTS=$$GET1^DIQ(100,RAORIFN_",",5) ;CPRS external
  1. QUIT
  1. ;
  1. OTHERS(RAOIFN,RADFN) ;are there other non-canceled exams tied
  1. ;to this order?
  1. ; Input: RAOIFN = RIS order IEN
  1. ; RADFN = DFN of patient
  1. ;
  1. ; returns: RAR: 1 if another non-canceled exam is tied to the RIS order
  1. ; else 0 (the default)
  1. N RA0,RA1,RA72,RAA,RAC,RAQ,RAR S (RA1,RAR)=0
  1. F S RA1=$O(^RADPT("AO",RAOIFN,RADFN,RA1)) Q:RA1'>0 D Q:RAR
  1. .S RA0=0 F S RA0=$O(^RADPT("AO",RAOIFN,RADFN,RA1,RA0)) Q:RA0'>0 D Q:RAR
  1. ..S RAQ=$G(^RADPT(RADFN,"DT",RA1,"P",RA0,0)) Q:RAQ="" ;bad data
  1. ..S RA72=+$P(RAQ,U,3),RA72(0)=$G(^RA(72,RA72,0))
  1. ..S:$P(RA72(0),U,3)>0 RAR=1
  1. ..Q
  1. .Q
  1. Q RAR
  1. ;