source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAPCE2.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1RAPCE2 ;HIRMFO/GJC-Interface with PCE APIs for wrkload, visits ;11/15/96 08:58
2 ;;5.0;Radiology/Nuclear Medicine;**10,17,21**;Mar 16, 1998
3 Q
4FAILBUL(RADFN,RADTI,RACNI,RADUZ) ; 'Rad/Nuc Med Credit Failure' bulletin
5 K XMB,XMB0,XMC0,XMDT,XMM,XMMG
6 N RA407,RA44,RA7002,RA7003,RA71,RA791,RA81,RACPT,RACSE,RAIMGLOC
7 N RAINTPTR,RAPAT,RAPCSTOP,RAPRC,RASSN,RATEXT,RAUSER,RAXAMDT,RAWHO
8 N RAXSET,Y
9 S RAWHO=$S($D(RAWHOERR):"Data rejected by PCE.",1:"")
10 S RAUSER=$P(^VA(200,RADUZ,0),"^"),RAPAT=$P($G(^DPT(RADFN,0)),"^")
11 S RASSN=$$SSN^RAUTL(),RA7002=$G(^RADPT(RADFN,"DT",RADTI,0))
12 S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
13 S RAXSET=$S(+$P(RA7002,"^",5):"This case is part of an exam set.",1:"")
14 S RA791(0)=$G(^RA(79.1,+$P(RA7002,"^",4),0))
15 S RAIMGLOC=+$P(RA791(0),"^")
16 S RAXAMDT=$$FMTE^XLFDT($P(RA7002,"^"),"1P"),RACSE=$P(RA7003,"^")
17 S RA71=$G(^RAMIS(71,+$P(RA7003,"^",2),0)),RAPRC=$E($P(RA71,"^"),1,45)
18 ; cpt string (#.01 and #2 flds)
19 S RA81=$$NAMCODE^RACPTMSC(+$P(RA71,"^",9),DT)
20 ; cpt code and active status
21 S RACPT=$P(RA81,"^")_$S($$ACTCODE^RACPTMSC(+$P(RA71,"^",9),$P(RA7002,"^")):"",1:" (inactive)")
22 S RAIMGLOC=$$GET1^DIQ(44,RAIMGLOC_",",.01)
23 S RAIMGLOC=$S(RAIMGLOC]"":RAIMGLOC,1:"Unknown")
24 S RA407=+$P(RA791(0),"^",22)
25 S RA407(0)=$G(^DIC(40.7,RA407,0)),RAPCSTOP=$P(RA407(0),"^")
26 S:RAPCSTOP]"" RAPCSTOP=$P(RA407(0),"^",2)_" "_RAPCSTOP
27 S:RAPCSTOP']"" RAPCSTOP="Unknown"
28 I $P(RA7003,"^",15) S RAINTPTR=$P($G(^VA(200,+$P(RA7003,"^",15),0)),"^")
29 I '$D(RAINTPTR),($P(RA7003,"^",12)) D ; grab Pri. Int Res
30 . S RAINTPTR=$P($G(^VA(200,+$P(RA7003,"^",12),0)),"^")
31 . Q
32 I '$D(RAINTPTR) S RAINTPTR="Unknown"
33 D:$D(@(RAEARRY)) XMTXT
34 ;
35 ; XMB(1) -> Patient Name XMB(2) -> Patient SSN
36 ; XMB(3) -> Exam D/t XMB(4) -> Case Number
37 ; XMB(5) -> Procedure XMB(6) -> Proc. CPT
38 ; XMB(7) -> CPT Modifiers XMB(8) -> Imag'g Loc Stop Code
39 ; XMB(9) -> Interpreter XMB(10)-> Imag'g Location
40 ; XMB(11)-> part of an exam set? XMB(12)-> Did PCE pass back an error?
41 ; XMB(13)-> Rad/Nuc Med User XMB(14)-> 1 line text comment
42 ;
43 S XMB(1)=RAPAT,XMB(2)=RASSN,XMB(3)=RAXAMDT,XMB(4)=RACSE,XMB(5)=RAPRC
44 S XMB(6)=RACPT
45 S XMB(8)=RAPCSTOP,XMB(9)=RAINTPTR,XMB(10)=RAIMGLOC
46 S XMB(11)=RAXSET,XMB(12)=RAWHO,XMB(13)=RAUSER,XMB(14)=""
47 I $G(RALCKFAL) D
48 . 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:"")_"."
49 . S:$G(RALCKFAL)=3 XMB(14)="Credit cannot be deleted for this exam due to lock failure for this exam date."
50 D MODS^RAUTL2 S XMB(7)=Y(1)
51 ;
52 S XMB="RAD/NUC MED CREDIT FAILURE"
53 D ^XMB:$D(^XMB(3.6,"B",XMB))
54 K XMB,XMB0,XMC0,XMDT,XMM,XMMG
55 Q
56XMTXT ; Set XMTEXT to local array which captures error text from the
57 ; 'Local variable name'($J). XMTEXT will only be set
58 ; conditionally and will only be set in this subroutine!
59 N RACNT,RADTYP,RAETYP,RAPROB,RASUB1,RASUB2,RATXT S RACNT=1,RASUB1=0
60 F S RASUB1=$O(@RAEARRY@($J,RASUB1)) Q:RASUB1'>0 D
61 . S RAPROB="" F S RAPROB=$O(@RAEARRY@($J,RASUB1,RAPROB)) Q:RAPROB="" D
62 .. S RAETYP=""
63 .. F S RAETYP=$O(@RAEARRY@($J,RASUB1,RAPROB,RAETYP)) Q:RAETYP="" D
64 ... S RADTYP=""
65 ... F S RADTYP=$O(@RAEARRY@($J,RASUB1,RAPROB,RAETYP,RADTYP)) Q:RADTYP="" D
66 .... S RASUB2=0
67 .... F S RASUB2=$O(@RAEARRY@($J,RASUB1,RAPROB,RAETYP,RADTYP,RASUB2)) Q:RASUB2'>0 D
68 ..... S RATXT=$G(@RAEARRY@($J,RASUB1,RAPROB,RAETYP,RADTYP,RASUB2))
69 ..... S:RATXT]"" RATEXT(RACNT)=RATXT,RACNT=RACNT+1
70 ..... Q
71 .... Q
72 ... Q
73 .. Q
74 . Q
75 S:$D(RATEXT) XMTEXT="RATEXT("
76 Q
Note: See TracBrowser for help on using the repository browser.