VistA-WorldVistAEHR/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAUTL0.m

125 lines
6.3 KiB
Mathematica

RAUTL0 ;HISC/CAH,FPT,GJC-Utility Routine ;11/5/99 13:19
;;5.0;Radiology/Nuclear Medicine;**2,13,10,71**;Mar 16, 1998;Build 10
; 07/05/2006 BAY/KAM Remedy Call 124379 Patch RA*5*71
UPSTAT ;QUEUE ONE REPORT TO UPDATE STATUS
;07/05/2006 BAY/KAM/GJC If RAHLTCPB is defined, do not broadcast ORM messages. RAHLTCPB is referenced in UP2^RAUTL1
;which is called from UP1^RAUTL1
N RAIO S RAIO=+$P($G(^RA(79,+RAMDIV,"RDEV")),"^") ; Resource Device?
S ZTRTN="STAT^RAUTL0",ZTIO=$S(RAIO>0:$$GET1^DIQ(3.5,RAIO_",",.01),1:"")
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)=""
S:$G(RADUZ) ZTSAVE("RADUZ")="" ;rpt may be verified by voice
; 07/05/2006 BAY/KAM Added next line
S:$G(RAHLTCPB) ZTSAVE("RAHLTCPB")="" ;rpt v'fied by VR; do not broadcast ORM messages.
D ^%ZTLOAD K SDUZ
I $D(ZTSK),'$D(RAQUEUED) W !,?5,"Status update queued!",! R X:2
Q
;
;Set off a series of actions as a result of report update: ;ch
; patient loc updated in Rpt Distrib file #74.4
; can also cause rec to be added to file 74.4 (depending on category
; of exam
; update status of exam if possible and do accompanying actions (such
; as update of status log if specified in div params, notify OE/RR,
; change order status if necessary, can also cause alerts to be
; fired off)
STAT ;TASKMAN ENTRY POINT TO UPDATE STATUS OF ONE REPORT
N RASAVE ; array to save off RADFN, RADTI & RACNI
S RAF1=1,Y=RARPT D RASET^RAUTL2,UP1^RAUTL1,STUFF^RARTST
S RASAVE("RADFN")=RADFN,RASAVE("RADTI")=RADTI,RASAVE("RACNI")=RACNI
S:$$ORVR^RAORDU()=2.5 ORVP=RADFN_";DPT(",ORBXDATA=RARPT
S RAEXFLD="ALL",D0=RARPT
D ^RARTFLDS,OENOTE^RAUTL00 ; OENOTE replaces STAT1
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
UPSTATM ;QUEUE MULTIPLE REPORTS TO UPDATE STATUSES
N RAIO S RAIO=+$P($G(^RA(79,+RAMDIV,"RDEV")),"^") ; Resource Device?
S ZTRTN="STATM^RAUTL0",ZTIO=$S(RAIO>0:$$GET1^DIQ(3.5,RAIO_",",.01),1:"")
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)=""
D ^%ZTLOAD K SDUZ I $D(ZTSK) W !,?5,"Status updates queued!",!
Q
;
STATM ;TASKMAN ENTRY POINT TO UPDATE STATUSES OF MULTIPLE REPORTS
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
I $D(ZTQUEUED) S ZTREQ="@"
Q
STATM1 ; Update statuses of multiple reports
N RASAVE ; array to save off RADFN, RADTI & RACNI
S:^TMP($J,"RA","DT",RARTDT,RA1) RAAB=1
S RASAVE("RADFN")=RADFN,RASAVE("RADTI")=RADTI,RASAVE("RACNI")=RACNI
S:$$ORVR^RAORDU()=2.5 ORVP=RADFN_";DPT(",ORBXDATA=RARPT
S RAEXFLD="ALL",D0=RARPT D ^RARTFLDS
D OENOTE^RAUTL00 K RAAB,ORIFN,ORNOTE
Q
;
EN ;Entry point to credit x-ray clinic stops
I $$PCE^RAWORK Q
S RASDC="" I '$D(RAMDIV)!'$D(RADTE)!'$D(RADFN)!'$D(RAPRIT)!'$D(RAMLC) G NOGO
S SDIV=RAMDIV,SDATE=$P(RADTE,"."),DFN=RADFN,SDC="",SDMSG="S"
G NOGO:'$D(^RAMIS(71,+RAPRIT,0)) S X=+$P(^(0),"^",9)
S X=$S(X="":"",1:$P($$NAMCODE^RACPTMSC(X,DT),"^"))
I X S X1=$S($D(^RA(79.1,+RAMLC,"PC")):^("PC"),1:"") G NOGO:'X1 S SDCPT(1)="900^"_X1_"^"_X
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
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
S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",24)="Y" W:'$D(ZTQUEUED) !?5,"Clinic Stop credited." G EXIT
;
CON S K=$S($D(^DIC(40.7,+J,0)):$P(^(0),"^",2),1:"") I K S:SDC'[K SDC=K_"^"_SDC S RASDC=SDC
Q
;
NOGO W:'$D(ZTQUEUED) *7,!?5,"Unable to credit a clinic stop!",!
I $D(RASDC),($D(DUZ)#2),($D(RADFN)),($D(RADTI)),($D(RACNI)) D
. D STPCDE(RASDC,DUZ,RADFN,RADTI,RACNI) ; Stop Code Error bulletin
. Q
EXIT K I,J,K,RAPR,RASDC,SDC,SDCPT,SDCTYPE,SDERR,SDATE,SDIV,X,X1 Q
;
STPCDE(RA0,RA1,RA2,RA3,RA4) ; Bulletin for Stop Code Credit error
; RA0 -> stop code numbers seperated by "^"'s (if not null)
; RA1 -> Rad/Nuc Med user (DUZ) RA2 -> Patient (RADFN)
; RA3 -> Inverse Xam D/T (RADTI) RA4 -> Exam node (RACNI)
Q:'$D(^VA(200,RA1,0))#2 ; invalid user info
Q:'$D(^RADPT(RA2,"DT",RA3,"P",RA4,0))#2 ; exam info incomplete
N RACASE,RADFN,RACPT,RALENFLG,RAI,RAPAT,RAPROC,RAREGX,RASSN,RASTOP
N RAUSER,RAXAM,RAXDT,XMB S RALENFLG=0
S RAUSER=$P($G(^VA(200,RA1,0)),"^"),RADFN=RA2
S RASSN=$$SSN^RAUTL(),RAREGX=$G(^RADPT(RA2,"DT",RA3,0))
S RAXAM=$G(^RADPT(RA2,"DT",RA3,"P",RA4,0)),RACASE=$P(RAXAM,"^")
S RAXDT=$P(RAREGX,"^"),RAPAT=$P($G(^DPT(RA2,0)),"^")
S RAPROC(0)=$G(^RAMIS(71,+$P(RAXAM,"^",2),0))
;S RACPT(0)=$G(^ICPT(+$P(RAPROC(0),"^",9),0)),RACPT=$P(RACPT(0),"^")
;S RACPT(4)=+$P(RACPT(0),"^",4),RACPT=$S(RACPT]"":RACPT,1:"Unknown")
;I RACPT(4),(RACPT]"") S RACPT=RACPT_" (invalid)"
S RACPT(0)=+$P(RAPROC(0),"^",9) ;ien to file 81
S RACPT=$P($$NAMCODE^RACPTMSC(RACPT(0),RAXDT),"^") ;.01 value file 81
S RACPT(4)=$$ACTCODE^RACPTMSC(RACPT(0),RAXDT) ;1=active,0=inactive
I RACPT']"" S RACPT="Unknown"
I 'RACPT(4),(RACPT'="Unknown") S RACPT=RACPT_" (invalid)"
S RAPROC=$E($P(RAPROC(0),"^"),1,45)
S RAPROC=$S(RAPROC]"":RAPROC,1:"Unknown")
I RA0']""!(RA0?1."^") D
. N RAPC S RAPC=+$P($G(^RA(79.1,+RAMLC,"PC")),"^")
. S:RAPC RASTOP="Missing STOP CODE data"
. S:'RAPC RASTOP="No Principal Clinic entered for '"_$P($G(^SC(+$P($G(^RA(79.1,+RAMLC,0)),"^"),0)),"^")_"'."
. Q
E D
. S RASTOP="" F RAI=1:1:$L(RA0,"^") D Q:RALENFLG
.. S RASTOP(2)=$P(RA0,"^",RAI) Q:RASTOP(2)']""
.. S RASTOP(1)=$P($G(^DIC(40.7,+$O(^DIC(40.7,"C",RASTOP(2),0)),0)),"^")
.. S RASTOP(3)=RASTOP(2)_" "_RASTOP(1)_", "
.. I ($L(RASTOP)+$L(RASTOP(3)))>512 S RALENFLG=1 Q:RALENFLG
.. S RASTOP=RASTOP_RASTOP(3)
.. Q
. I $P(RASTOP,", ",$L(RASTOP,", "))']"" D
.. S RASTOP=$P(RASTOP,", ",1,$L(RASTOP,", ")-1)
.. Q
. Q
; XMB(1) -> Full patient name XMB(2) -> patient SSN
; XMB(3) -> Examination Date XMB(4) -> Case Number
; XMB(5) -> Procedure XMB(6) -> CPT Code
; XMB(7) -> Stop Code(s) XMB(8) -> Rad/Nuc Med user
S XMB(1)=RAPAT,XMB(2)=RASSN,XMB(3)=$$FMTE^XLFDT(RAXDT),XMB(4)=RACASE
S XMB(5)=RAPROC,XMB(6)=RACPT,XMB(7)=RASTOP,XMB(8)=RAUSER
S XMB="RAD/NUC MED CREDIT STOP ERROR"
D ^XMB:$D(^XMB(3.6,"B",XMB))
K XMB0,XMC0,XMDT,XMM,XMMG
Q