- RAPCE2 ;HIRMFO/GJC-Interface with PCE APIs for wrkload, visits ;11/15/96 08:58
- ;;5.0;Radiology/Nuclear Medicine;**10,17,21**;Mar 16, 1998
- 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 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
- RAPCE2 ;HIRMFO/GJC-Interface with PCE APIs for wrkload, visits ;11/15/96 08:58
- +1 ;;5.0;Radiology/Nuclear Medicine;**10,17,21**;Mar 16, 1998
- +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 SET RAWHO=$SELECT($DATA(RAWHOERR):"Data rejected by PCE.",1:"")
- +6 SET RAUSER=$PIECE(^VA(200,RADUZ,0),"^")
- SET RAPAT=$PIECE($GET(^DPT(RADFN,0)),"^")
- +7 SET RASSN=$$SSN^RAUTL()
- SET RA7002=$GET(^RADPT(RADFN,"DT",RADTI,0))
- +8 SET RA7003=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
- +9 SET RAXSET=$SELECT(+$PIECE(RA7002,"^",5):"This case is part of an exam set.",1:"")
- +10 SET RA791(0)=$GET(^RA(79.1,+$PIECE(RA7002,"^",4),0))
- +11 SET RAIMGLOC=+$PIECE(RA791(0),"^")
- +12 SET RAXAMDT=$$FMTE^XLFDT($PIECE(RA7002,"^"),"1P")
- SET RACSE=$PIECE(RA7003,"^")
- +13 SET RA71=$GET(^RAMIS(71,+$PIECE(RA7003,"^",2),0))
- SET RAPRC=$EXTRACT($PIECE(RA71,"^"),1,45)
- +14 ; cpt string (#.01 and #2 flds)
- +15 SET RA81=$$NAMCODE^RACPTMSC(+$PIECE(RA71,"^",9),DT)
- +16 ; cpt code and active status
- +17 SET RACPT=$PIECE(RA81,"^")_$SELECT($$ACTCODE^RACPTMSC(+$PIECE(RA71,"^",9),$PIECE(RA7002,"^")):"",1:" (inactive)")
- +18 SET RAIMGLOC=$$GET1^DIQ(44,RAIMGLOC_",",.01)
- +19 SET RAIMGLOC=$SELECT(RAIMGLOC]"":RAIMGLOC,1:"Unknown")
- +20 SET RA407=+$PIECE(RA791(0),"^",22)
- +21 SET RA407(0)=$GET(^DIC(40.7,RA407,0))
- SET RAPCSTOP=$PIECE(RA407(0),"^")
- +22 IF RAPCSTOP]""
- SET RAPCSTOP=$PIECE(RA407(0),"^",2)_" "_RAPCSTOP
- +23 IF RAPCSTOP']""
- SET RAPCSTOP="Unknown"
- +24 IF $PIECE(RA7003,"^",15)
- SET RAINTPTR=$PIECE($GET(^VA(200,+$PIECE(RA7003,"^",15),0)),"^")
- +25 ; grab Pri. Int Res
- IF '$DATA(RAINTPTR)
- IF ($PIECE(RA7003,"^",12))
- Begin DoDot:1
- +26 SET RAINTPTR=$PIECE($GET(^VA(200,+$PIECE(RA7003,"^",12),0)),"^")
- +27 QUIT
- End DoDot:1
- +28 IF '$DATA(RAINTPTR)
- SET RAINTPTR="Unknown"
- +29 IF $DATA(@(RAEARRY))
- DO XMTXT
- +30 ;
- +31 ; XMB(1) -> Patient Name XMB(2) -> Patient SSN
- +32 ; XMB(3) -> Exam D/t XMB(4) -> Case Number
- +33 ; XMB(5) -> Procedure XMB(6) -> Proc. CPT
- +34 ; XMB(7) -> CPT Modifiers XMB(8) -> Imag'g Loc Stop Code
- +35 ; XMB(9) -> Interpreter XMB(10)-> Imag'g Location
- +36 ; XMB(11)-> part of an exam set? XMB(12)-> Did PCE pass back an error?
- +37 ; XMB(13)-> Rad/Nuc Med User XMB(14)-> 1 line text comment
- +38 ;
- +39 SET XMB(1)=RAPAT
- SET XMB(2)=RASSN
- SET XMB(3)=RAXAMDT
- SET XMB(4)=RACSE
- SET XMB(5)=RAPRC
- +40 SET XMB(6)=RACPT
- +41 SET XMB(8)=RAPCSTOP
- SET XMB(9)=RAINTPTR
- SET XMB(10)=RAIMGLOC
- +42 SET XMB(11)=RAXSET
- SET XMB(12)=RAWHO
- SET XMB(13)=RAUSER
- SET XMB(14)=""
- +43 IF $GET(RALCKFAL)
- Begin DoDot:1
- +44 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:"")_"."
- +45 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
- +46 DO MODS^RAUTL2
- SET XMB(7)=Y(1)
- +47 ;
- +48 SET XMB="RAD/NUC MED CREDIT FAILURE"
- +49 IF $DATA(^XMB(3.6,"B",XMB))
- DO ^XMB
- +50 KILL XMB,XMB0,XMC0,XMDT,XMM,XMMG
- +51 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
