source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAUTL0.m

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

initial load of FOIAVistA 6/30/08 version
File size: 6.3 KB
Line 
1RAUTL0 ;HISC/CAH,FPT,GJC-Utility Routine ;11/5/99 13:19
2 ;;5.0;Radiology/Nuclear Medicine;**2,13,10,71**;Mar 16, 1998;Build 10
3 ; 07/05/2006 BAY/KAM Remedy Call 124379 Patch RA*5*71
4UPSTAT ;QUEUE ONE REPORT TO UPDATE STATUS
5 ;07/05/2006 BAY/KAM/GJC If RAHLTCPB is defined, do not broadcast ORM messages. RAHLTCPB is referenced in UP2^RAUTL1
6 ;which is called from UP1^RAUTL1
7 N RAIO S RAIO=+$P($G(^RA(79,+RAMDIV,"RDEV")),"^") ; Resource Device?
8 S ZTRTN="STAT^RAUTL0",ZTIO=$S(RAIO>0:$$GET1^DIQ(3.5,RAIO_",",.01),1:"")
9 S ZTDTH=$H,ZTDESC="Rad/Nuc Med UPDATE STATUS OF ONE REPORT" S SDUZ=$G(RADUZ) S:'SDUZ SDUZ=DUZ F I="RAMDIV","RAMDV","RARPT","RAONLINE","RAAB","RAMLC","RAIMGTY","SDUZ" S ZTSAVE(I)=""
10 S:$G(RADUZ) ZTSAVE("RADUZ")="" ;rpt may be verified by voice
11 ; 07/05/2006 BAY/KAM Added next line
12 S:$G(RAHLTCPB) ZTSAVE("RAHLTCPB")="" ;rpt v'fied by VR; do not broadcast ORM messages.
13 D ^%ZTLOAD K SDUZ
14 I $D(ZTSK),'$D(RAQUEUED) W !,?5,"Status update queued!",! R X:2
15 Q
16 ;
17 ;Set off a series of actions as a result of report update: ;ch
18 ; patient loc updated in Rpt Distrib file #74.4
19 ; can also cause rec to be added to file 74.4 (depending on category
20 ; of exam
21 ; update status of exam if possible and do accompanying actions (such
22 ; as update of status log if specified in div params, notify OE/RR,
23 ; change order status if necessary, can also cause alerts to be
24 ; fired off)
25STAT ;TASKMAN ENTRY POINT TO UPDATE STATUS OF ONE REPORT
26 N RASAVE ; array to save off RADFN, RADTI & RACNI
27 S RAF1=1,Y=RARPT D RASET^RAUTL2,UP1^RAUTL1,STUFF^RARTST
28 S RASAVE("RADFN")=RADFN,RASAVE("RADTI")=RADTI,RASAVE("RACNI")=RACNI
29 S:$$ORVR^RAORDU()=2.5 ORVP=RADFN_";DPT(",ORBXDATA=RARPT
30 S RAEXFLD="ALL",D0=RARPT
31 D ^RARTFLDS,OENOTE^RAUTL00 ; OENOTE replaces STAT1
32 I $D(ZTQUEUED) S ZTREQ="@"
33 Q
34 ;
35UPSTATM ;QUEUE MULTIPLE REPORTS TO UPDATE STATUSES
36 N RAIO S RAIO=+$P($G(^RA(79,+RAMDIV,"RDEV")),"^") ; Resource Device?
37 S ZTRTN="STATM^RAUTL0",ZTIO=$S(RAIO>0:$$GET1^DIQ(3.5,RAIO_",",.01),1:"")
38 S ZTDTH=$H,ZTDESC="Rad/Nuc Med UPDATE STATUSES OF MULTIPLE REPORTS" S SDUZ=$G(RADUZ) S:'SDUZ SDUZ=DUZ F I="^TMP($J,""RA"",""DT"",","RAMDV","RAMDIV","RAONLINE","RAMLC","RAIMGTY","SDUZ" S ZTSAVE(I)=""
39 D ^%ZTLOAD K SDUZ I $D(ZTSK) W !,?5,"Status updates queued!",!
40 Q
41 ;
42STATM ;TASKMAN ENTRY POINT TO UPDATE STATUSES OF MULTIPLE REPORTS
43 S RAF1=1 F RARTDT=0:0 S RARTDT=$O(^TMP($J,"RA","DT",RARTDT)) Q:RARTDT'>0 F RA1=0:0 S RA1=$O(^TMP($J,"RA","DT",RARTDT,RA1)) Q:RA1'>0 S (RARPT,Y)=RA1 D RASET^RAUTL2,UP1^RAUTL1,STUFF^RARTST,STATM1
44 I $D(ZTQUEUED) S ZTREQ="@"
45 Q
46STATM1 ; Update statuses of multiple reports
47 N RASAVE ; array to save off RADFN, RADTI & RACNI
48 S:^TMP($J,"RA","DT",RARTDT,RA1) RAAB=1
49 S RASAVE("RADFN")=RADFN,RASAVE("RADTI")=RADTI,RASAVE("RACNI")=RACNI
50 S:$$ORVR^RAORDU()=2.5 ORVP=RADFN_";DPT(",ORBXDATA=RARPT
51 S RAEXFLD="ALL",D0=RARPT D ^RARTFLDS
52 D OENOTE^RAUTL00 K RAAB,ORIFN,ORNOTE
53 Q
54 ;
55EN ;Entry point to credit x-ray clinic stops
56 I $$PCE^RAWORK Q
57 S RASDC="" I '$D(RAMDIV)!'$D(RADTE)!'$D(RADFN)!'$D(RAPRIT)!'$D(RAMLC) G NOGO
58 S SDIV=RAMDIV,SDATE=$P(RADTE,"."),DFN=RADFN,SDC="",SDMSG="S"
59 G NOGO:'$D(^RAMIS(71,+RAPRIT,0)) S X=+$P(^(0),"^",9)
60 S X=$S(X="":"",1:$P($$NAMCODE^RACPTMSC(X,DT),"^"))
61 I X S X1=$S($D(^RA(79.1,+RAMLC,"PC")):^("PC"),1:"") G NOGO:'X1 S SDCPT(1)="900^"_X1_"^"_X
62 I $O(^RAMIS(71,RAPRIT,"STOP",0)) F I=0:0 S I=$O(^RAMIS(71,RAPRIT,"STOP",I)) Q:I'>0 I $D(^RAMIS(71,RAPRIT,"STOP",I,0)) S J=+^(0) D CON
63 S SDCTYPE=$S($D(SDCPT(1)):"B",1:"S") W:'$D(ZTQUEUED) !!?5,"Attempting to credit a clinic stop.",! D EN3^SDACS I SDERR=1 G NOGO
64 S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",24)="Y" W:'$D(ZTQUEUED) !?5,"Clinic Stop credited." G EXIT
65 ;
66CON S K=$S($D(^DIC(40.7,+J,0)):$P(^(0),"^",2),1:"") I K S:SDC'[K SDC=K_"^"_SDC S RASDC=SDC
67 Q
68 ;
69NOGO W:'$D(ZTQUEUED) *7,!?5,"Unable to credit a clinic stop!",!
70 I $D(RASDC),($D(DUZ)#2),($D(RADFN)),($D(RADTI)),($D(RACNI)) D
71 . D STPCDE(RASDC,DUZ,RADFN,RADTI,RACNI) ; Stop Code Error bulletin
72 . Q
73EXIT K I,J,K,RAPR,RASDC,SDC,SDCPT,SDCTYPE,SDERR,SDATE,SDIV,X,X1 Q
74 ;
75STPCDE(RA0,RA1,RA2,RA3,RA4) ; Bulletin for Stop Code Credit error
76 ; RA0 -> stop code numbers seperated by "^"'s (if not null)
77 ; RA1 -> Rad/Nuc Med user (DUZ) RA2 -> Patient (RADFN)
78 ; RA3 -> Inverse Xam D/T (RADTI) RA4 -> Exam node (RACNI)
79 Q:'$D(^VA(200,RA1,0))#2 ; invalid user info
80 Q:'$D(^RADPT(RA2,"DT",RA3,"P",RA4,0))#2 ; exam info incomplete
81 N RACASE,RADFN,RACPT,RALENFLG,RAI,RAPAT,RAPROC,RAREGX,RASSN,RASTOP
82 N RAUSER,RAXAM,RAXDT,XMB S RALENFLG=0
83 S RAUSER=$P($G(^VA(200,RA1,0)),"^"),RADFN=RA2
84 S RASSN=$$SSN^RAUTL(),RAREGX=$G(^RADPT(RA2,"DT",RA3,0))
85 S RAXAM=$G(^RADPT(RA2,"DT",RA3,"P",RA4,0)),RACASE=$P(RAXAM,"^")
86 S RAXDT=$P(RAREGX,"^"),RAPAT=$P($G(^DPT(RA2,0)),"^")
87 S RAPROC(0)=$G(^RAMIS(71,+$P(RAXAM,"^",2),0))
88 ;S RACPT(0)=$G(^ICPT(+$P(RAPROC(0),"^",9),0)),RACPT=$P(RACPT(0),"^")
89 ;S RACPT(4)=+$P(RACPT(0),"^",4),RACPT=$S(RACPT]"":RACPT,1:"Unknown")
90 ;I RACPT(4),(RACPT]"") S RACPT=RACPT_" (invalid)"
91 S RACPT(0)=+$P(RAPROC(0),"^",9) ;ien to file 81
92 S RACPT=$P($$NAMCODE^RACPTMSC(RACPT(0),RAXDT),"^") ;.01 value file 81
93 S RACPT(4)=$$ACTCODE^RACPTMSC(RACPT(0),RAXDT) ;1=active,0=inactive
94 I RACPT']"" S RACPT="Unknown"
95 I 'RACPT(4),(RACPT'="Unknown") S RACPT=RACPT_" (invalid)"
96 S RAPROC=$E($P(RAPROC(0),"^"),1,45)
97 S RAPROC=$S(RAPROC]"":RAPROC,1:"Unknown")
98 I RA0']""!(RA0?1."^") D
99 . N RAPC S RAPC=+$P($G(^RA(79.1,+RAMLC,"PC")),"^")
100 . S:RAPC RASTOP="Missing STOP CODE data"
101 . S:'RAPC RASTOP="No Principal Clinic entered for '"_$P($G(^SC(+$P($G(^RA(79.1,+RAMLC,0)),"^"),0)),"^")_"'."
102 . Q
103 E D
104 . S RASTOP="" F RAI=1:1:$L(RA0,"^") D Q:RALENFLG
105 .. S RASTOP(2)=$P(RA0,"^",RAI) Q:RASTOP(2)']""
106 .. S RASTOP(1)=$P($G(^DIC(40.7,+$O(^DIC(40.7,"C",RASTOP(2),0)),0)),"^")
107 .. S RASTOP(3)=RASTOP(2)_" "_RASTOP(1)_", "
108 .. I ($L(RASTOP)+$L(RASTOP(3)))>512 S RALENFLG=1 Q:RALENFLG
109 .. S RASTOP=RASTOP_RASTOP(3)
110 .. Q
111 . I $P(RASTOP,", ",$L(RASTOP,", "))']"" D
112 .. S RASTOP=$P(RASTOP,", ",1,$L(RASTOP,", ")-1)
113 .. Q
114 . Q
115 ; XMB(1) -> Full patient name XMB(2) -> patient SSN
116 ; XMB(3) -> Examination Date XMB(4) -> Case Number
117 ; XMB(5) -> Procedure XMB(6) -> CPT Code
118 ; XMB(7) -> Stop Code(s) XMB(8) -> Rad/Nuc Med user
119 S XMB(1)=RAPAT,XMB(2)=RASSN,XMB(3)=$$FMTE^XLFDT(RAXDT),XMB(4)=RACASE
120 S XMB(5)=RAPROC,XMB(6)=RACPT,XMB(7)=RASTOP,XMB(8)=RAUSER
121 S XMB="RAD/NUC MED CREDIT STOP ERROR"
122 D ^XMB:$D(^XMB(3.6,"B",XMB))
123 K XMB0,XMC0,XMDT,XMM,XMMG
124 Q
Note: See TracBrowser for help on using the repository browser.