RAPCE2 ;HIRMFO/GJC-Interface with PCE APIs for wrkload, visits ; Oct 10, 2019@09:52:21
;;5.0;Radiology/Nuclear Medicine;**10,17,21,163**;Mar 16, 1998;Build 1
Q
FAILBUL(RADFN,RADTI,RACNI,RADUZ) ; 'Rad/Nuc Med Credit Failure' bulletin
K XMB,XMB0,XMC0,XMDT,XMM,XMMG
N RA407,RA44,RA7002,RA7003,RA71,RA791,RA81,RACPT,RACSE,RAIMGLOC
N RAINTPTR,RAPAT,RAPCSTOP,RAPRC,RASSN,RATEXT,RAUSER,RAXAMDT,RAWHO
N RAXSET,Y
S:$G(RADUZ)<.5 RADUZ=.5 ;KLM/163 - INC7656335
S RAWHO=$S($D(RAWHOERR):"Data rejected by PCE.",1:"")
S RAUSER=$P(^VA(200,RADUZ,0),"^"),RAPAT=$P($G(^DPT(RADFN,0)),"^")
S RASSN=$$SSN^RAUTL(),RA7002=$G(^RADPT(RADFN,"DT",RADTI,0))
S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
S RAXSET=$S(+$P(RA7002,"^",5):"This case is part of an exam set.",1:"")
S RA791(0)=$G(^RA(79.1,+$P(RA7002,"^",4),0))
S RAIMGLOC=+$P(RA791(0),"^")
S RAXAMDT=$$FMTE^XLFDT($P(RA7002,"^"),"1P"),RACSE=$P(RA7003,"^")
S RA71=$G(^RAMIS(71,+$P(RA7003,"^",2),0)),RAPRC=$E($P(RA71,"^"),1,45)
; cpt string (#.01 and #2 flds)
S RA81=$$NAMCODE^RACPTMSC(+$P(RA71,"^",9),DT)
; cpt code and active status
S RACPT=$P(RA81,"^")_$S($$ACTCODE^RACPTMSC(+$P(RA71,"^",9),$P(RA7002,"^")):"",1:" (inactive)")
S RAIMGLOC=$$GET1^DIQ(44,RAIMGLOC_",",.01)
S RAIMGLOC=$S(RAIMGLOC]"":RAIMGLOC,1:"Unknown")
S RA407=+$P(RA791(0),"^",22)
S RA407(0)=$G(^DIC(40.7,RA407,0)),RAPCSTOP=$P(RA407(0),"^")
S:RAPCSTOP]"" RAPCSTOP=$P(RA407(0),"^",2)_" "_RAPCSTOP
S:RAPCSTOP']"" RAPCSTOP="Unknown"
I $P(RA7003,"^",15) S RAINTPTR=$P($G(^VA(200,+$P(RA7003,"^",15),0)),"^")
I '$D(RAINTPTR),($P(RA7003,"^",12)) D ; grab Pri. Int Res
. S RAINTPTR=$P($G(^VA(200,+$P(RA7003,"^",12),0)),"^")
. Q
I '$D(RAINTPTR) S RAINTPTR="Unknown"
D:$D(@(RAEARRY)) XMTXT
;
; XMB(1) -> Patient Name XMB(2) -> Patient SSN
; XMB(3) -> Exam D/t XMB(4) -> Case Number
; XMB(5) -> Procedure XMB(6) -> Proc. CPT
; XMB(7) -> CPT Modifiers XMB(8) -> Imag'g Loc Stop Code
; XMB(9) -> Interpreter XMB(10)-> Imag'g Location
; XMB(11)-> part of an exam set? XMB(12)-> Did PCE pass back an error?
; XMB(13)-> Rad/Nuc Med User XMB(14)-> 1 line text comment
;
S XMB(1)=RAPAT,XMB(2)=RASSN,XMB(3)=RAXAMDT,XMB(4)=RACSE,XMB(5)=RAPRC
S XMB(6)=RACPT
S XMB(8)=RAPCSTOP,XMB(9)=RAINTPTR,XMB(10)=RAIMGLOC
S XMB(11)=RAXSET,XMB(12)=RAWHO,XMB(13)=RAUSER,XMB(14)=""
I $G(RALCKFAL) D
. S:$G(RALCKFAL)<3 XMB(14)="Crediting for this exam failed due to lock failure while completing an exam"_$S($G(RALCKFAL)=2:" for duplicate procedures",1:"")_"."
. S:$G(RALCKFAL)=3 XMB(14)="Credit cannot be deleted for this exam due to lock failure for this exam date."
D MODS^RAUTL2 S XMB(7)=Y(1)
;
S XMB="RAD/NUC MED CREDIT FAILURE"
D ^XMB:$D(^XMB(3.6,"B",XMB))
K XMB,XMB0,XMC0,XMDT,XMM,XMMG
Q
XMTXT ; Set XMTEXT to local array which captures error text from the
; 'Local variable name'($J). XMTEXT will only be set
; conditionally and will only be set in this subroutine!
N RACNT,RADTYP,RAETYP,RAPROB,RASUB1,RASUB2,RATXT S RACNT=1,RASUB1=0
F S RASUB1=$O(@RAEARRY@($J,RASUB1)) Q:RASUB1'>0 D
. S RAPROB="" F S RAPROB=$O(@RAEARRY@($J,RASUB1,RAPROB)) Q:RAPROB="" D
.. S RAETYP=""
.. F S RAETYP=$O(@RAEARRY@($J,RASUB1,RAPROB,RAETYP)) Q:RAETYP="" D
... S RADTYP=""
... F S RADTYP=$O(@RAEARRY@($J,RASUB1,RAPROB,RAETYP,RADTYP)) Q:RADTYP="" D
.... S RASUB2=0
.... F S RASUB2=$O(@RAEARRY@($J,RASUB1,RAPROB,RAETYP,RADTYP,RASUB2)) Q:RASUB2'>0 D
..... S RATXT=$G(@RAEARRY@($J,RASUB1,RAPROB,RAETYP,RADTYP,RASUB2))
..... S:RATXT]"" RATEXT(RACNT)=RATXT,RACNT=RACNT+1
..... Q
.... Q
... Q
.. Q
. Q
S:$D(RATEXT) XMTEXT="RATEXT("
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAPCE2 3693 printed Dec 13, 2024@02:38:32 Page 2
RAPCE2 ;HIRMFO/GJC-Interface with PCE APIs for wrkload, visits ; Oct 10, 2019@09:52:21
+1 ;;5.0;Radiology/Nuclear Medicine;**10,17,21,163**;Mar 16, 1998;Build 1
+2 QUIT
FAILBUL(RADFN,RADTI,RACNI,RADUZ) ; 'Rad/Nuc Med Credit Failure' bulletin
+1 KILL XMB,XMB0,XMC0,XMDT,XMM,XMMG
+2 NEW RA407,RA44,RA7002,RA7003,RA71,RA791,RA81,RACPT,RACSE,RAIMGLOC
+3 NEW RAINTPTR,RAPAT,RAPCSTOP,RAPRC,RASSN,RATEXT,RAUSER,RAXAMDT,RAWHO
+4 NEW RAXSET,Y
+5 ;KLM/163 - INC7656335
if $GET(RADUZ)<.5
SET RADUZ=.5
+6 SET RAWHO=$SELECT($DATA(RAWHOERR):"Data rejected by PCE.",1:"")
+7 SET RAUSER=$PIECE(^VA(200,RADUZ,0),"^")
SET RAPAT=$PIECE($GET(^DPT(RADFN,0)),"^")
+8 SET RASSN=$$SSN^RAUTL()
SET RA7002=$GET(^RADPT(RADFN,"DT",RADTI,0))
+9 SET RA7003=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
+10 SET RAXSET=$SELECT(+$PIECE(RA7002,"^",5):"This case is part of an exam set.",1:"")
+11 SET RA791(0)=$GET(^RA(79.1,+$PIECE(RA7002,"^",4),0))
+12 SET RAIMGLOC=+$PIECE(RA791(0),"^")
+13 SET RAXAMDT=$$FMTE^XLFDT($PIECE(RA7002,"^"),"1P")
SET RACSE=$PIECE(RA7003,"^")
+14 SET RA71=$GET(^RAMIS(71,+$PIECE(RA7003,"^",2),0))
SET RAPRC=$EXTRACT($PIECE(RA71,"^"),1,45)
+15 ; cpt string (#.01 and #2 flds)
+16 SET RA81=$$NAMCODE^RACPTMSC(+$PIECE(RA71,"^",9),DT)
+17 ; cpt code and active status
+18 SET RACPT=$PIECE(RA81,"^")_$SELECT($$ACTCODE^RACPTMSC(+$PIECE(RA71,"^",9),$PIECE(RA7002,"^")):"",1:" (inactive)")
+19 SET RAIMGLOC=$$GET1^DIQ(44,RAIMGLOC_",",.01)
+20 SET RAIMGLOC=$SELECT(RAIMGLOC]"":RAIMGLOC,1:"Unknown")
+21 SET RA407=+$PIECE(RA791(0),"^",22)
+22 SET RA407(0)=$GET(^DIC(40.7,RA407,0))
SET RAPCSTOP=$PIECE(RA407(0),"^")
+23 if RAPCSTOP]""
SET RAPCSTOP=$PIECE(RA407(0),"^",2)_" "_RAPCSTOP
+24 if RAPCSTOP']""
SET RAPCSTOP="Unknown"
+25 IF $PIECE(RA7003,"^",15)
SET RAINTPTR=$PIECE($GET(^VA(200,+$PIECE(RA7003,"^",15),0)),"^")
+26 ; grab Pri. Int Res
IF '$DATA(RAINTPTR)
IF ($PIECE(RA7003,"^",12))
Begin DoDot:1
+27 SET RAINTPTR=$PIECE($GET(^VA(200,+$PIECE(RA7003,"^",12),0)),"^")
+28 QUIT
End DoDot:1
+29 IF '$DATA(RAINTPTR)
SET RAINTPTR="Unknown"
+30 if $DATA(@(RAEARRY))
DO XMTXT
+31 ;
+32 ; XMB(1) -> Patient Name XMB(2) -> Patient SSN
+33 ; XMB(3) -> Exam D/t XMB(4) -> Case Number
+34 ; XMB(5) -> Procedure XMB(6) -> Proc. CPT
+35 ; XMB(7) -> CPT Modifiers XMB(8) -> Imag'g Loc Stop Code
+36 ; XMB(9) -> Interpreter XMB(10)-> Imag'g Location
+37 ; XMB(11)-> part of an exam set? XMB(12)-> Did PCE pass back an error?
+38 ; XMB(13)-> Rad/Nuc Med User XMB(14)-> 1 line text comment
+39 ;
+40 SET XMB(1)=RAPAT
SET XMB(2)=RASSN
SET XMB(3)=RAXAMDT
SET XMB(4)=RACSE
SET XMB(5)=RAPRC
+41 SET XMB(6)=RACPT
+42 SET XMB(8)=RAPCSTOP
SET XMB(9)=RAINTPTR
SET XMB(10)=RAIMGLOC
+43 SET XMB(11)=RAXSET
SET XMB(12)=RAWHO
SET XMB(13)=RAUSER
SET XMB(14)=""
+44 IF $GET(RALCKFAL)
Begin DoDot:1
+45 if $GET(RALCKFAL)<3
SET XMB(14)="Crediting for this exam failed due to lock failure while completing an exam"_$SELECT($GET(RALCKFAL)=2:" for duplicate procedures",1:"")_"."
+46 if $GET(RALCKFAL)=3
SET XMB(14)="Credit cannot be deleted for this exam due to lock failure for this exam date."
End DoDot:1
+47 DO MODS^RAUTL2
SET XMB(7)=Y(1)
+48 ;
+49 SET XMB="RAD/NUC MED CREDIT FAILURE"
+50 if $DATA(^XMB(3.6,"B",XMB))
DO ^XMB
+51 KILL XMB,XMB0,XMC0,XMDT,XMM,XMMG
+52 QUIT
XMTXT ; Set XMTEXT to local array which captures error text from the
+1 ; 'Local variable name'($J). XMTEXT will only be set
+2 ; conditionally and will only be set in this subroutine!
+3 NEW RACNT,RADTYP,RAETYP,RAPROB,RASUB1,RASUB2,RATXT
SET RACNT=1
SET RASUB1=0
+4 FOR
SET RASUB1=$ORDER(@RAEARRY@($JOB,RASUB1))
if RASUB1'>0
QUIT
Begin DoDot:1
+5 SET RAPROB=""
FOR
SET RAPROB=$ORDER(@RAEARRY@($JOB,RASUB1,RAPROB))
if RAPROB=""
QUIT
Begin DoDot:2
+6 SET RAETYP=""
+7 FOR
SET RAETYP=$ORDER(@RAEARRY@($JOB,RASUB1,RAPROB,RAETYP))
if RAETYP=""
QUIT
Begin DoDot:3
+8 SET RADTYP=""
+9 FOR
SET RADTYP=$ORDER(@RAEARRY@($JOB,RASUB1,RAPROB,RAETYP,RADTYP))
if RADTYP=""
QUIT
Begin DoDot:4
+10 SET RASUB2=0
+11 FOR
SET RASUB2=$ORDER(@RAEARRY@($JOB,RASUB1,RAPROB,RAETYP,RADTYP,RASUB2))
if RASUB2'>0
QUIT
Begin DoDot:5
+12 SET RATXT=$GET(@RAEARRY@($JOB,RASUB1,RAPROB,RAETYP,RADTYP,RASUB2))
+13 if RATXT]""
SET RATEXT(RACNT)=RATXT
SET RACNT=RACNT+1
+14 QUIT
End DoDot:5
+15 QUIT
End DoDot:4
+16 QUIT
End DoDot:3
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
+19 if $DATA(RATEXT)
SET XMTEXT="RATEXT("
+20 QUIT
