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

RAPCE1.m

Go to the documentation of this file. 
  1. RAPCE1 ;HIRMFO/GJC-Interface with PCE APIs for workload, visits;6/4/96  15:03 ;5/28/97  12:59
  1.  ;;5.0;Radiology/Nuclear Medicine;**17,21**;Mar 16, 1998
  1.  Q
  1. 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
  1.  ;and re-credit any complete ones that are not part of exam sets.
  1.  ;
  1.  ; Input Variables: RADFN=Patient DFN
  1.  ;                  RADTI=Inv. date/time of exam
  1.  ;
  1.  ; $$DELVFILE^PXAPI returns: 1 if no errors, -4 if transaction OK but
  1.  ;                  visit rec still there, else error condition
  1.  ;
  1.  N RA7002,RA7003,RARECMPL,RAVSIT,RAXAMSET,RALCKFAL,RAEARRY
  1.  K ^TMP("RAPXAPI",$J)
  1.  S RALCKFAL=0 ; need define this due its being used in RAPCE
  1.  ; RARECMPL (re-complete), if set, is used to suppress displaying msgs
  1.  S RA7002=$G(^RADPT(RADFN,"DT",RADTI,0))
  1.  S RAXAMSET=+$P(RA7002,"^",5)
  1.  S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
  1.  ;If this case has no visit ptr, whether it is within a set or not,
  1.  ; quit because crediting never took place (exam set crediting is
  1.  ; on an "all or nothing" basis)
  1.  S RAVSIT=$P(RA7003,U,27) I 'RAVSIT Q
  1.  S RAPKG=+$O(^DIC(9.4,"B","RADIOLOGY/NUCLEAR MEDICINE",0))
  1.  S RADTE=9999999.9999-RADTI
  1.  S RA791=$G(^RA(79.1,+$P(RA7002,"^",4),0))
  1.  S RAEARRY="RAERROR" N @RAEARRY
  1.  D DELVST
  1.  K ^TMP("RAPXAPI",$J)
  1.  Q
  1. DELVST ; Delete all Rad/Nuc Med pkg data from
  1.  ; Visit file, other V-files for exam date/time
  1.  ; lock at DT level due re-crediting all prev cmpltd exms for same dt/tm
  1.  ; also, lock before deleting entire visit, in case can't delete
  1.  ;     cl.stp.rec and visit pointers from locked record
  1.  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
  1.  ; quit if lock fails at DT level
  1.  D DELVPTR(RADFN,RADTI)
  1.  S RASULT=$$DELVFILE^PXAPI("ALL",RAVSIT,RAPKG,"",0,0,0)
  1.  I RASULT=1!(RASULT=-4) D
  1.  . D MULCS(RADFN,RADTI)
  1.  . W:'$D(ZTQUEUED)&('$D(RADUPRC)) !,"Credit deleted for this Visit."
  1.  . Q:RAXAMSET
  1.  .;non-exmsets: re-credit cmplt'd cases of same dt/tm via exmset logic
  1.  .; set var RAXAMSET to 1 to use code that credits all exms in same dt/tm
  1.  . S RAXAMSET=1 N RA71,RACNT,RABAD,RACNT,RASTAT S RACNT=0,RARECMPL=1 K RAVSIT D EN2^RAPCE
  1.  . Q
  1.  L -^RADPT(RADFN,"DT",RADTI)
  1.  Q
  1. DELVPTR(RADFN,RADTI) ; each case in this exmset: del case ptrs to Visit file
  1.  ; (subfile: 70.03 Field #: 27) ;visit ptr fld
  1.  N RACNI,RADA1 S RACNI=0
  1.  F  S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0  D
  1.  . S RADA1(70.03,RACNI_","_RADTI_","_RADFN_",",27)="@"
  1.  . D FILE^DIE("K","RADA1")
  1.  . K RADA1 ; clear var before reuse, incase filing problem met
  1.  Q
  1. MULCS(RADFN,RADTI) ; Clear the 'Clinic Stop Recorded?' field for ea case
  1.  ; in this exam set
  1.  ; (subfile: 70.03 Field #: 23) ;credit recorded fld
  1.  N RACNI,RADA2 S RACNI=0
  1.  F  S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0  D
  1.  . S RADA2(70.03,RACNI_","_RADTI_","_RADFN_",",23)="@"
  1.  . D FILE^DIE("K","RADA2")
  1.  . K RADA2 ; clear var before reuse, incase filing problem met
  1.  . Q
  1.  Q
  1. REPNT(RADFN,RADTI) ; Repopulate the visit field
  1.  N RAFDA S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",27)=RAVSIT
  1.  D FILE^DIE("K","RAFDA")
  1.  Q
  1. 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
  1.  ; return 1 if more than 1 completed procedure of the same name/dt/tm
  1.  ;             as this case
  1.  ; RAX(raprcien) = no. cases with this procedure ien
  1.  S RADUPRC=0
  1.  I '$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)),'$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI),-1) Q  ;only 1 case for this dt/tm
  1.  N I,J,K,RAX,RAPRCIEN
  1.  S I=0,RAPRCIEN=+$P(RA7003,U,2)
  1. C1 S I=$O(^RADPT(RADFN,"DT",RADTI,"P",I)) G:I'=+I C9
  1.  S J=$P(^(I,0),U,2),K=$P(^(0),U,3) ; J = proc ien, K = status ien
  1.  G:$P($G(^RA(72,+K,0)),U,3)'=9 C1 ; skip if ordercode is not 9
  1.  S RACOMIEN(I)="" ; save ien of completed cases for use in RESEND
  1.  S:J RAX(J)=$G(RAX(J))+1
  1.  G C1
  1. C9 Q:$G(RAX(RAPRCIEN))<2
  1.  S RADUPRC=1 ; more than one completed case has the same procedure for this dt/tm
  1.  Q
  1. RESEND ; del and resend this dt/tm
  1.  ; delete what was previously sent to PCE
  1.  ; need to lock before finding RAVSIT because another case with same
  1.  ;    patient/procedure/dt/tm may be setting up the visit pointer
  1.  ;    for the first time for this dt/tm, at this moment
  1.  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
  1.  N I
  1.  S I=0 ; find visit pointer from first complted case's non-null visit fld
  1. D1 S I=$O(RACOMIEN(I)) G:I'=+I D9
  1.  G:$P(^RADPT(RADFN,"DT",RADTI,"P",I,0),U,27)="" D1
  1.  S RAVSIT=$P(^(0),U,27)
  1. D9 I $G(RAVSIT)="" G DUNL ; no valid vst ptr to delete
  1.  D DELVST
  1.  W:$G(RASENT)&('$D(ZTQUEUED)) !?5,"Visit credited for duplicate procedure."
  1. DUNL L -^RADPT(RADFN,"DT",RADTI)
  1.  Q