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