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

RAKRDIT.m

Go to the documentation of this file. 
  1. RAKRDIT ;Hines OI/GJC-pass exam info within a date range, to PCE
  1.  ;;5.0;Radiology/Nuclear Medicine;**31**;Mar 16, 1998
  1.  Q
  1. EN1 ;DBIA 3445 read from file 42
  1.  ;Supported entry point used to credit examinations that have failed
  1.  ;to be credited in the past.  The user will be asked to supply the
  1.  ;following required information:
  1.  ;* Imaging Location (active, receives regular credit, & has a DSS ID)
  1.  ;* Date Range
  1.  ;
  1.  ;From this, we look at the exam records and determine if the exam
  1.  ;has been credited and whether or not the patients are outpatients.
  1.  ;
  1.  ;The software needs to check if these exams are single exams or
  1.  ;exam-sets (linked to a single report, known as a print-set, or
  1.  ;linked to unique reports) and send to PCE only those exams that
  1.  ;have an Exam Status of 'Complete'.
  1.  ;
  1.  ;Intergration Agreements (IAs) used within this software
  1.  ;#3445-$$GET1^DIQ(42,ien_file_42,.03,"I") ;the SERVICE of the ward
  1.  ;
  1. IMGLOC W !!,?2,"Select an Imaging Location from the IMAGING LOCATIONS (#79.1)"
  1.  W !?2,"file that is active, receives regular credit, and has a valid"
  1.  W !?2,"DSS ID.",!
  1.  K DIC S RATDY=$$DT^XLFDT(),DIC="^RA(79.1,"
  1.  S DIC("S")="N RAI S RAI=$G(^(0)) I '$P(RAI,""^"",19),($P(RAI,""^"",21)=0),($P(RAI,""^"",22)]"""")"
  1.  S DIC("A")="Enter the Imaging Location that you wish to credit: "
  1.  S DIC(0)="QEANZ" D ^DIC K DIC
  1.  I Y=-1 D  D KILL Q
  1.  .W !!?2,$C(7),"Imaging Location selection invalid, exiting."
  1.  .Q
  1.  S RAILOC=Y_"^"_Y(0,0) ;ien file 79.1^ien file 44^.01 value file 44
  1.  ;
  1. DATE1 K DIR S DIR(0)="D^2110101:"_RATDY_":EA"
  1.  S DIR("?",1)="Enter the date to begin searching for exams that have not been credited."
  1.  S DIR("A")="Enter the starting date: ",DIR("?")="Time is not allowed."
  1.  D ^DIR K DIR
  1.  I $D(DIRUT) D  D KILL Q
  1.  .W !!?2,$C(7),"Starting date not selected, exiting."
  1.  .Q
  1.  S (RASTRT,RADTE)=Y
  1.  ;
  1. DATE2 K DIR S DIR(0)="D^"_RASTRT_":"_RATDY_":EA"
  1.  S DIR("A")="Enter the ending date: "
  1.  S DIR("?",1)="Enter the date to end the search for exams that have not been credited."
  1.  S DIR("?")="Dates cannot preceed: "_$$FMTE^XLFDT(RASTRT,"1P")_"; time is not allowed."
  1.  D ^DIR K DIR
  1.  I $D(DIRUT) D  D KILL Q
  1.  .W !!?2,$C(7),"Ending date not selected, exiting."
  1.  .Q
  1.  S RAEND=$$FMADD^XLFDT(Y,0,24,0,0) ;to include all data, set to midnight
  1.  ;
  1.  S ZTIO="",ZTRTN="QUEUED^RAKRDIT",ZTDESC="Rad/Nuc Med attempt to credit exams for a specific imaging location and date range"
  1.  F I="RAEND","RADTE","RASTRT","RAILOC" S ZTSAVE(I)=""
  1.  W ! D ^%ZTLOAD
  1.  I $D(ZTSK) D
  1.  .W !!?2,"Request queued: "_ZTSK_" @ "_$$HTE^XLFDT($G(ZTSK("D"),"error"))
  1.  .Q
  1.  K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK D KILL
  1.  Q
  1.  ;
  1. QUEUED ;begin checking for uncredited exams...
  1.  S:$G(U)'="^" U="^" S:$D(ZTQUEUED) ZTREQ="@" S RAXIT=0
  1. EXAMS F  S RADTE=$O(^RADPT("AR",RADTE)) Q:RADTE'>0!(RADTE>RAEND)  D
  1.  .;^RADPT("AR",date/time of exam,patient dfn,inverse exam date/time)=""
  1.  .S RADFN=0
  1.  .F  S RADFN=$O(^RADPT("AR",RADTE,RADFN)) Q:RADFN'>0  D  Q:RAXIT
  1.  ..S RADTI=0
  1.  ..F  S RADTI=$O(^RADPT("AR",RADTE,RADFN,RADTI)) Q:RADTI'>0  D  Q:RAXIT
  1.  ...S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)),RAXSET=0
  1.  ...Q:$P(RAY2,"^",4)'=+RAILOC  ;not the specified I-Loc
  1.  ...S RACNI=0
  1.  ...;check the exam to see if it is part of an exam set.  If it is,
  1.  ...;the call to RAPCE performs checking logic on all the descendents.
  1.  ...I $P(RAY2,"^",5) S RAXSET=1 D  Q  ;we have an exam set...
  1.  ....S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0
  1.  ....S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
  1.  ....Q:+$$EN1^RASETU($P(RAY3,U,11),RADFN)'=9  ; check all descendents
  1.  ....;for a minimum order number of nine (9).  This indicates that all
  1.  ....;descendents are in the COMPLETE examination status.  Status info
  1.  ....;about exam set passed back from EN1^RASETU in the following
  1.  ....;format: min status_"^"_max status_"^"_$S(All_Statuses=0:1,1:0)
  1.  ....Q:$$ELIG(RAY3)  ;must be an outpatient
  1.  ....D COMPLETE^RAPCE(RADFN,RADTI,RACNI)
  1.  ....D XAMSET(RADFN,RADTI) ;CREDIT METHOD of Reg. Credit on descendents
  1.  ....I $$S^%ZTLOAD() S (RAXIT,ZTSTOP)=1
  1.  ....Q
  1.  ...;we do not have an exam set, proceed as usual...
  1.  ...F  S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0  D  Q:RAXIT
  1.  ....S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
  1.  ....Q:$$ELIG(RAY3)  ;must be an outpatient
  1.  ....D COMPLETE^RAPCE(RADFN,RADTI,RACNI)
  1.  ....D:$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,24)="Y" CREDITM(RADFN,RADTI,RACNI) ;update CREDIT METHOD fld from No Credit to Regular Credit
  1.  ....I $$S^%ZTLOAD() S (RAXIT,ZTSTOP)=1
  1.  ....Q
  1.  ...I $$S^%ZTLOAD() S (RAXIT,ZTSTOP)=1
  1.  ...Q
  1.  ..I $$S^%ZTLOAD() S (RAXIT,ZTSTOP)=1
  1.  ..Q
  1.  .I $$S^%ZTLOAD() S (RAXIT,ZTSTOP)=1
  1.  .Q
  1.  Q
  1. KILL ; kill local variables, clean up partition
  1.  K DIC,DIRUT,DTOUT,DUOUT,I,RADFN,RADTE,RADTI,RAEND,RAILOC,RASTRT,RATDY
  1.  K RAXIT,RAXSET,RAY2,RAY3,X,Y
  1.  Q
  1. ELIG(RAY3) ;Is this record eligible to be credited?  If so, the CLINIC
  1.  ;STOP RECORDED? (#23) cannot be set to yes, the patient must not be
  1.  ;located on a ward (outpatient), & the exam must be in a complete
  1.  ;status (order_number = 9)
  1.  ;Input: RAY3 set to - ^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
  1.  I 'RAXSET,($P($G(^RA(72,+$P(RAY3,"^",3),0)),U,3)='9) Q 1 ;check single
  1.  ;exam records for an order number of nine (9).  This means the exam is
  1.  ;in a status of COMPLETE.  Note: the order numbers of the descendent
  1.  ;exams within an exam-set is checked with $$EN1^RASETU...
  1.  Q:$P(RAY3,"^",24)="Y" 1 ;clinic stop credited, skip this exam
  1.  I $P(RAY3,"^",6)]"",($$GET1^DIQ(42,$P(RAY3,"^",6),.03,"I")'="D") Q 1
  1.  ;Note: if a ward, then it must have a SERVICE of DOMICILIARY to be
  1.  ;consider an outpatient
  1.  Q 0
  1.  ;
  1. CREDITM(RADFN,RADTI,RACNI) ;Change the CREDIT METHOD (DD: 70.03, fld: 26)
  1.  ;from "No Credit" (2) to "Regular Credit" (0)
  1.  ;Note: Crediting was skipped because the Imaging Location (I-Loc) was
  1.  ;marked as 'NO CREDIT'.  To credit at this time, the I-Loc must have
  1.  ;CREDIT METHOD set to 'REGULAR CREDIT'.  All exam records must be
  1.  ;updated accordingly.
  1.  ;Input=RADFN: patient dfn, RADTI: inv. exam date/time, RACNI: case ien
  1.  N RAFDA S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",26)=0 ; zero
  1.  D FILE^DIE("K","RAFDA")
  1.  Q
  1.  ;
  1. XAMSET(RADFN,RADTI) ; change CREDIT METHOD from No Credit to Regular Credit
  1.  ;Input=RADFN: patient dfn, RADTI: inv. exam date/time
  1.  N RACNI S RACNI=0
  1.  F  S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0  D
  1.  .D:$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,24)="Y" CREDITM(RADFN,RADTI,RACNI) ;update CREDIT METHOD fld from No Credit to Regular Credit
  1.  Q