RAPCE1 ;HIRMFO/GJC-Interface with PCE APIs for workload, visits;6/4/96 15:03 ; Apr 28, 2022@08:43:27
;;5.0;Radiology/Nuclear Medicine;**17,21,189**;Mar 16, 1998;Build 1
Q
UNCOMPL(RADFN,RADTI,RACNI) ; When an exam backs out of a complete status
;back out all credit, visit pointers for all rad exams on this d/t
;and re-credit any complete ones that are not part of exam sets.
;
; Input Variables: RADFN=Patient DFN
; RADTI=Inv. date/time of exam
;
; $$DELVFILE^PXAPI returns: 1 if no errors, -4 if transaction OK but
; visit rec still there, else error condition
;
N RA7002,RA7003,RARECMPL,RAVSIT,RAXAMSET,RALCKFAL,RAEARRY
K ^TMP("RAPXAPI",$J)
S RALCKFAL=0 ; need define this due its being used in RAPCE
; RARECMPL (re-complete), if set, is used to suppress displaying msgs
S RA7002=$G(^RADPT(RADFN,"DT",RADTI,0))
S RAXAMSET=+$P(RA7002,"^",5)
S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
;If this case has no visit ptr, whether it is within a set or not,
; quit because crediting never took place (exam set crediting is
; on an "all or nothing" basis)
S RAVSIT=$P(RA7003,U,27) I 'RAVSIT Q
S RAPKG=+$O(^DIC(9.4,"B","RADIOLOGY/NUCLEAR MEDICINE",0))
S RADTE=9999999.9999-RADTI
S RA791=$G(^RA(79.1,+$P(RA7002,"^",4),0))
S RAEARRY="RAERROR" N @RAEARRY
D DELVST
K ^TMP("RAPXAPI",$J)
Q
DELVST ; Delete all Rad/Nuc Med pkg data from
; Visit file, other V-files for exam date/time
; lock at DT level due re-crediting all prev cmpltd exms for same dt/tm
; also, lock before deleting entire visit, in case can't delete
; cl.stp.rec and visit pointers from locked record
L +^RADPT(RADFN,"DT",RADTI):30 I '$T S RALCKFAL=3 D FAILBUL^RAPCE2(RADFN,RADTI,RACNI,$S($G(RADUZ):RADUZ,1:DUZ)) W !?5,"Credit cannot be deleted for this exam due to lock failure for this exam date." Q
; quit if lock fails at DT level
D DELVPTR(RADFN,RADTI)
S RASULT=$$DELVFILE^PXAPI("ALL",RAVSIT,RAPKG,"",0,0,0)
I RASULT=1!(RASULT=-4) D
. D MULCS(RADFN,RADTI)
. W:'$D(ZTQUEUED)&('$D(RADUPRC)) !,"Credit deleted for this Visit."
. Q:RAXAMSET
.;non-exmsets: re-credit cmplt'd cases of same dt/tm via exmset logic
.; set var RAXAMSET to 1 to use code that credits all exms in same dt/tm
. S RAXAMSET=1 N RA71,RACNT,RABAD,RACNT,RASTAT S RACNT=0,RARECMPL=1 K RAVSIT D EN2^RAPCE
. Q
L -^RADPT(RADFN,"DT",RADTI)
Q
DELVPTR(RADFN,RADTI) ; each case in this exmset: del case ptrs to Visit file
; (subfile: 70.03 Field #: 27) ;visit ptr fld
N RACNI,RADA1 S RACNI=0
F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0 D
. S RADA1(70.03,RACNI_","_RADTI_","_RADFN_",",27)="@"
. D FILE^DIE("K","RADA1")
. K RADA1 ; clear var before reuse, incase filing problem met
Q
MULCS(RADFN,RADTI) ; Clear the 'Clinic Stop Recorded?' field for ea case
; in this exam set
; (subfile: 70.03 Field #: 23) ;credit recorded fld
N RACNI,RADA2 S RACNI=0
F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0 D
. S RADA2(70.03,RACNI_","_RADTI_","_RADFN_",",23)="@"
. D FILE^DIE("K","RADA2")
. K RADA2 ; clear var before reuse, incase filing problem met
. Q
Q
REPNT(RADFN,RADTI) ; Repopulate the visit field
N RAFDA S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",27)=RAVSIT
D FILE^DIE("K","RAFDA")
Q
CKDUP ; are there more than one procedure of same name ?
; return 0 if 1 or fewer completed procedure of the same name/dt/tm
; return 1 if more than 1 completed procedure of the same name/dt/tm
; as this case
; RAX(raprcien) = no. cases with this procedure ien
S RADUPRC=0
I '$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)),'$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI),-1) Q ;only 1 case for this dt/tm
N I,J,K,RAX,RAPRCIEN
S I=0,RAPRCIEN=+$P(RA7003,U,2)
C1 S I=$O(^RADPT(RADFN,"DT",RADTI,"P",I)) G:I'=+I C9
S J=$P(^(I,0),U,2),K=$P(^(0),U,3) ; J = proc ien, K = status ien
G:$P($G(^RA(72,+K,0)),U,3)'=9 C1 ; skip if ordercode is not 9
S RACOMIEN(I)="" ; save ien of completed cases for use in RESEND
S:J RAX(J)=$G(RAX(J))+1
G C1
C9 Q:$G(RAX(RAPRCIEN))<2
S RADUPRC=1 ; more than one completed case has the same procedure for this dt/tm
Q
RESEND ; del and resend this dt/tm
; delete what was previously sent to PCE
; need to lock before finding RAVSIT because another case with same
; patient/procedure/dt/tm may be setting up the visit pointer
; for the first time for this dt/tm, at this moment
L +^RADPT(RADFN,"DT",RADTI):30 I '$T S RALCKFAL=2 D FAILBUL^RAPCE2(RADFN,RADTI,RACNI,$S($G(RADUZ):RADUZ,1:DUZ)) Q ;quit resend if DT-level lock failed
N I
S I=0 ; find visit pointer from first complted case's non-null visit fld
D1 S I=$O(RACOMIEN(I)) G:I'=+I D9
G:$P(^RADPT(RADFN,"DT",RADTI,"P",I,0),U,27)="" D1
S RAVSIT=$P(^(0),U,27)
D9 I $G(RAVSIT)="" G DUNL ; no valid vst ptr to delete
D DELVST
W:$G(RASENT)&('$D(ZTQUEUED)) !?5,"Visit credited for duplicate procedure."
DUNL L -^RADPT(RADFN,"DT",RADTI)
Q
RSCRFLR ;p189/KLM Resend credit failure to PCE (PX211 work around)
K RAVSIT,RASULT,PXAERR,PXKERROR("VISIT")
H 1 S RASULT=$$DATA2PCE^PXAPI("^TMP(""RAPXAPI"",$J)",RAPKG,"RAD/NUC MED",.RAVSIT,"","","","",.@RAEARRY)
I $G(RAVSIT)>0 D ;Visit file pointer, set 'Credit recorded' to yes.
. W:'$D(ZTQUEUED)&('$D(RARECMPL)) !?5,"Visit credited.",!
. D:'RAXAMSET VISIT^RAPCE(RADFN,RADTI,RACNI,RAVSIT)
. D:'RAXAMSET RECDCS^RAPCE(RADFN,RADTI,RACNI) ; only one exam, not a set
. D:RAXAMSET MULCS^RAPCE(RADFN,RADTI) ; set, update all exams!
. S RASENT=1 ; sent to PCE was okay
. Q
E D
. N RAWHOERR S RAWHOERR=""
. W:'$D(ZTQUEUED)&('$D(RARECMPL)) !?5,$C(7),"Unable to credit.",!
. I '$G(RAXAMSET) D FAILBUL^RAPCE2(RADFN,RADTI,RACNI,$S($G(RADUZ):RADUZ,1:DUZ))
. I $G(RAXAMSET) D
.. S RACNI=0 F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0 D FAILBUL^RAPCE2(RADFN,RADTI,RACNI,$S($G(RADUZ):RADUZ,1:DUZ))
.. Q
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAPCE1 5940 printed Apr 09, 2024@21:40:19 Page 2
RAPCE1 ;HIRMFO/GJC-Interface with PCE APIs for workload, visits;6/4/96 15:03 ; Apr 28, 2022@08:43:27
+1 ;;5.0;Radiology/Nuclear Medicine;**17,21,189**;Mar 16, 1998;Build 1
+2 QUIT
UNCOMPL(RADFN,RADTI,RACNI) ; When an exam backs out of a complete status
+1 ;back out all credit, visit pointers for all rad exams on this d/t
+2 ;and re-credit any complete ones that are not part of exam sets.
+3 ;
+4 ; Input Variables: RADFN=Patient DFN
+5 ; RADTI=Inv. date/time of exam
+6 ;
+7 ; $$DELVFILE^PXAPI returns: 1 if no errors, -4 if transaction OK but
+8 ; visit rec still there, else error condition
+9 ;
+10 NEW RA7002,RA7003,RARECMPL,RAVSIT,RAXAMSET,RALCKFAL,RAEARRY
+11 KILL ^TMP("RAPXAPI",$JOB)
+12 ; need define this due its being used in RAPCE
SET RALCKFAL=0
+13 ; RARECMPL (re-complete), if set, is used to suppress displaying msgs
+14 SET RA7002=$GET(^RADPT(RADFN,"DT",RADTI,0))
+15 SET RAXAMSET=+$PIECE(RA7002,"^",5)
+16 SET RA7003=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
+17 ;If this case has no visit ptr, whether it is within a set or not,
+18 ; quit because crediting never took place (exam set crediting is
+19 ; on an "all or nothing" basis)
+20 SET RAVSIT=$PIECE(RA7003,U,27)
IF 'RAVSIT
QUIT
+21 SET RAPKG=+$ORDER(^DIC(9.4,"B","RADIOLOGY/NUCLEAR MEDICINE",0))
+22 SET RADTE=9999999.9999-RADTI
+23 SET RA791=$GET(^RA(79.1,+$PIECE(RA7002,"^",4),0))
+24 SET RAEARRY="RAERROR"
NEW @RAEARRY
+25 DO DELVST
+26 KILL ^TMP("RAPXAPI",$JOB)
+27 QUIT
DELVST ; Delete all Rad/Nuc Med pkg data from
+1 ; Visit file, other V-files for exam date/time
+2 ; lock at DT level due re-crediting all prev cmpltd exms for same dt/tm
+3 ; also, lock before deleting entire visit, in case can't delete
+4 ; cl.stp.rec and visit pointers from locked record
+5 LOCK +^RADPT(RADFN,"DT",RADTI):30
IF '$TEST
SET RALCKFAL=3
DO FAILBUL^RAPCE2(RADFN,RADTI,RACNI,$SELECT($GET(RADUZ):RADUZ,1:DUZ))
WRITE !?5,"Credit cannot be deleted for this exam due to lock failure for this exam date."
QUIT
+6 ; quit if lock fails at DT level
+7 DO DELVPTR(RADFN,RADTI)
+8 SET RASULT=$$DELVFILE^PXAPI("ALL",RAVSIT,RAPKG,"",0,0,0)
+9 IF RASULT=1!(RASULT=-4)
Begin DoDot:1
+10 DO MULCS(RADFN,RADTI)
+11 if '$DATA(ZTQUEUED)&('$DATA(RADUPRC))
WRITE !,"Credit deleted for this Visit."
+12 if RAXAMSET
QUIT
+13 ;non-exmsets: re-credit cmplt'd cases of same dt/tm via exmset logic
+14 ; set var RAXAMSET to 1 to use code that credits all exms in same dt/tm
+15 SET RAXAMSET=1
NEW RA71,RACNT,RABAD,RACNT,RASTAT
SET RACNT=0
SET RARECMPL=1
KILL RAVSIT
DO EN2^RAPCE
+16 QUIT
End DoDot:1
+17 LOCK -^RADPT(RADFN,"DT",RADTI)
+18 QUIT
DELVPTR(RADFN,RADTI) ; each case in this exmset: del case ptrs to Visit file
+1 ; (subfile: 70.03 Field #: 27) ;visit ptr fld
+2 NEW RACNI,RADA1
SET RACNI=0
+3 FOR
SET RACNI=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI))
if RACNI'>0
QUIT
Begin DoDot:1
+4 SET RADA1(70.03,RACNI_","_RADTI_","_RADFN_",",27)="@"
+5 DO FILE^DIE("K","RADA1")
+6 ; clear var before reuse, incase filing problem met
KILL RADA1
End DoDot:1
+7 QUIT
MULCS(RADFN,RADTI) ; Clear the 'Clinic Stop Recorded?' field for ea case
+1 ; in this exam set
+2 ; (subfile: 70.03 Field #: 23) ;credit recorded fld
+3 NEW RACNI,RADA2
SET RACNI=0
+4 FOR
SET RACNI=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI))
if RACNI'>0
QUIT
Begin DoDot:1
+5 SET RADA2(70.03,RACNI_","_RADTI_","_RADFN_",",23)="@"
+6 DO FILE^DIE("K","RADA2")
+7 ; clear var before reuse, incase filing problem met
KILL RADA2
+8 QUIT
End DoDot:1
+9 QUIT
REPNT(RADFN,RADTI) ; Repopulate the visit field
+1 NEW RAFDA
SET RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",27)=RAVSIT
+2 DO FILE^DIE("K","RAFDA")
+3 QUIT
CKDUP ; are there more than one procedure of same name ?
+1 ; return 0 if 1 or fewer completed procedure of the same name/dt/tm
+2 ; return 1 if more than 1 completed procedure of the same name/dt/tm
+3 ; as this case
+4 ; RAX(raprcien) = no. cases with this procedure ien
+5 SET RADUPRC=0
+6 ;only 1 case for this dt/tm
IF '$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI))
IF '$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI),-1)
QUIT
+7 NEW I,J,K,RAX,RAPRCIEN
+8 SET I=0
SET RAPRCIEN=+$PIECE(RA7003,U,2)
C1 SET I=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",I))
if I'=+I
GOTO C9
+1 ; J = proc ien, K = status ien
SET J=$PIECE(^(I,0),U,2)
SET K=$PIECE(^(0),U,3)
+2 ; skip if ordercode is not 9
if $PIECE($GET(^RA(72,+K,0)),U,3)'=9
GOTO C1
+3 ; save ien of completed cases for use in RESEND
SET RACOMIEN(I)=""
+4 if J
SET RAX(J)=$GET(RAX(J))+1
+5 GOTO C1
C9 if $GET(RAX(RAPRCIEN))<2
QUIT
+1 ; more than one completed case has the same procedure for this dt/tm
SET RADUPRC=1
+2 QUIT
RESEND ; del and resend this dt/tm
+1 ; delete what was previously sent to PCE
+2 ; need to lock before finding RAVSIT because another case with same
+3 ; patient/procedure/dt/tm may be setting up the visit pointer
+4 ; for the first time for this dt/tm, at this moment
+5 ;quit resend if DT-level lock failed
LOCK +^RADPT(RADFN,"DT",RADTI):30
IF '$TEST
SET RALCKFAL=2
DO FAILBUL^RAPCE2(RADFN,RADTI,RACNI,$SELECT($GET(RADUZ):RADUZ,1:DUZ))
QUIT
+6 NEW I
+7 ; find visit pointer from first complted case's non-null visit fld
SET I=0
D1 SET I=$ORDER(RACOMIEN(I))
if I'=+I
GOTO D9
+1 if $PIECE(^RADPT(RADFN,"DT",RADTI,"P",I,0),U,27)=""
GOTO D1
+2 SET RAVSIT=$PIECE(^(0),U,27)
D9 ; no valid vst ptr to delete
IF $GET(RAVSIT)=""
GOTO DUNL
+1 DO DELVST
+2 if $GET(RASENT)&('$DATA(ZTQUEUED))
WRITE !?5,"Visit credited for duplicate procedure."
DUNL LOCK -^RADPT(RADFN,"DT",RADTI)
+1 QUIT
RSCRFLR ;p189/KLM Resend credit failure to PCE (PX211 work around)
+1 KILL RAVSIT,RASULT,PXAERR,PXKERROR("VISIT")
+2 HANG 1
SET RASULT=$$DATA2PCE^PXAPI("^TMP(""RAPXAPI"",$J)",RAPKG,"RAD/NUC MED",.RAVSIT,"","","","",.@RAEARRY)
+3 ;Visit file pointer, set 'Credit recorded' to yes.
IF $GET(RAVSIT)>0
Begin DoDot:1
+4 if '$DATA(ZTQUEUED)&('$DATA(RARECMPL))
WRITE !?5,"Visit credited.",!
+5 if 'RAXAMSET
DO VISIT^RAPCE(RADFN,RADTI,RACNI,RAVSIT)
+6 ; only one exam, not a set
if 'RAXAMSET
DO RECDCS^RAPCE(RADFN,RADTI,RACNI)
+7 ; set, update all exams!
if RAXAMSET
DO MULCS^RAPCE(RADFN,RADTI)
+8 ; sent to PCE was okay
SET RASENT=1
+9 QUIT
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 NEW RAWHOERR
SET RAWHOERR=""
+12 if '$DATA(ZTQUEUED)&('$DATA(RARECMPL))
WRITE !?5,$CHAR(7),"Unable to credit.",!
+13 IF '$GET(RAXAMSET)
DO FAILBUL^RAPCE2(RADFN,RADTI,RACNI,$SELECT($GET(RADUZ):RADUZ,1:DUZ))
+14 IF $GET(RAXAMSET)
Begin DoDot:2
+15 SET RACNI=0
FOR
SET RACNI=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI))
if RACNI'>0
QUIT
DO FAILBUL^RAPCE2(RADFN,RADTI,RACNI,$SELECT($GET(RADUZ):RADUZ,1:DUZ))
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 QUIT
