317 lines
11 KiB
Mathematica
317 lines
11 KiB
Mathematica
RARTE6 ;HISC/SM Restore deleted report ;01/10/08 13:44
|
|
;;5.0;Radiology/Nuclear Medicine;**56**;Mar 16, 1998;Build 3
|
|
;Supported IA #10060 ^VA(200
|
|
;Supported IA #2053 FILE^DIE, UPDATE^DIE
|
|
;Supported IA #2052 GET1^DID
|
|
;Supported IA #2056 GET1^DIQ
|
|
;Supported IA #10103 NOW^XLFDT
|
|
;Supported IA #2055 ROOT^DILFD
|
|
;Supported IA #10060 GETS^DIQ
|
|
Q
|
|
RSTR ;restore deleted report
|
|
F I=1:1:5 W !?4,$P($T(INTRO+I),";;",2)
|
|
W !
|
|
S RAXIT=0 ; =0 exit normally, =1 exit early
|
|
I '$D(^XUSEC("RA MGR",DUZ)) W !!,"Supervisory key RA MGR is needed for this option." Q
|
|
S DIC("S")="I $P(^(0),""^"",5)=""X""" ;only select deleted reports
|
|
S DIC("A")="Select Deleted Report to restore: "
|
|
S DIC="^RARPT(",DIC(0)="AEMQZ"
|
|
D DICW^RARTST1,^DIC K DIC I Y<0 G FINISH
|
|
S RARPT=+Y
|
|
W !
|
|
D CHECK G:RAXIT NOTDONE ;check if case has rpt & DX codes
|
|
D ASK1 G:RAXIT NOTDONE ;ask if want restore deleted report
|
|
D ASSOC G:RAXIT NOTDONE ;display associated case(s) & ask user again if want continue
|
|
D RESTORE ;restore rpt status, link rpt to case(s)
|
|
D FINISH
|
|
Q
|
|
CHECK ; check if associated case(s) has rpt and DX codes
|
|
S RA74=^RARPT(RARPT,0)
|
|
S RADFN=+$P(RA74,U,2),RADTI=9999999.9999-$P(RA74,U,3),RACN=+$P($P(RA74,U,1),"-",2)
|
|
S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0))
|
|
S RA70=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
|
|
I 'RADFN!('RADTI)!('RACNI)!(RA70="") D ERR0 Q
|
|
S RANME=$$GET1^DIQ(2,RADFN,.01),RAST=+$P(RA70,U,3)
|
|
S RAPRC=$S($D(^RAMIS(71,+$P(RA70,U,2),0)):$P(^(0),U),1:"Unknown")
|
|
S RASSN=$$SSN^RAUTL,RASUBY0=RA70
|
|
S RANODE=$G(^RADPT(RADFN,"DT",RADTI,0))
|
|
; check if case(s) already have a report
|
|
D EN2^RAUTL20(.RAMEMARR)
|
|
I RAPRTSET D
|
|
.S RA1=0
|
|
.F S RA1=$O(RAMEMARR(RA1)) Q:RA1="" D
|
|
..I $P(^RADPT(RADFN,"DT",RADTI,"P",RA1,0),U,17)'="" D ERR3(+RAMEMARR(RA1))
|
|
..Q
|
|
.Q
|
|
E I $P(RA70,U,17) D ERR3(RACN) Q
|
|
; check if case(s) already have DX codes, staff, resident
|
|
; don't use IF ELSE here due to outside calls
|
|
;
|
|
; Printset cases
|
|
I RAPRTSET D Q
|
|
.S RA1=0
|
|
.F S RA1=$O(RAMEMARR(RA1)) Q:RA1="" D
|
|
..; check primary
|
|
..F RA2=13,15,12 I $P(^RADPT(RADFN,"DT",RADTI,"P",RA1,0),U,RA2)'="" D ERR2(+RAMEMARR(RA1),70.03,RA2)
|
|
..; check secondary
|
|
..S RAIENS=1_","_RA1_","_RADTI_","_RADFN_","
|
|
..F RA2=70.14,70.11,70.09 S RAROOT=$$ROOT^DILFD(RA2,RAIENS) I $O(@(RAROOT_"0)")) D ERR2(+RAMEMARR(RA1),RA2,.01)
|
|
..Q
|
|
.Q
|
|
; single case
|
|
F RA2=13,15,12 I $P(RA70,U,RA2) D ERR2(RACN,70.03,RA2)
|
|
S RAIENS=1_","_RACNI_","_RADTI_","_RADFN_","
|
|
F RA2=70.14,70.11,70.09 S RAROOT=$$ROOT^DILFD(RA2,RAIENS) I $O(@(RAROOT_"0)")) D ERR2(RACN,RA2,.01)
|
|
Q
|
|
ASK1 ; ask if want to restore report
|
|
; RAPRVIEN last Activity Log rec in subfile 74.01
|
|
; RAPRVST previous report status logged in latest activity log rec
|
|
; RALAST last activity log record
|
|
S RAPRVIEN=$O(^RARPT(RARPT,"L",""),-1)
|
|
I 'RAPRVIEN D ERR1 Q
|
|
S RALAST=$G(^RARPT(RARPT,"L",+RAPRVIEN,0))
|
|
I RALAST="" D ERR1 Q
|
|
S RAPRVST=$P(RALAST,U,4) ;previous rpt status
|
|
K DIR
|
|
S DIR(0)="Y",DIR("B")="NO"
|
|
S DIR("A")="Do you want to restore this deleted report"
|
|
S DIR("?")="Answer ""Y"" to assign the previous report status, "_$$GET1^DIQ(74.01,RAPRVIEN_","_RARPT_",",4)_", to this report."
|
|
D ^DIR K DIR
|
|
S:$D(DIRUT) RAXIT=1
|
|
S:'Y RAXIT=1
|
|
Q
|
|
ASSOC ;
|
|
; list case(s) for this report
|
|
S (Y,RADTE)=+$P(RANODE,U)
|
|
D D^RAUTL S RADATE=Y
|
|
D DISPLAY
|
|
W !
|
|
K DIR
|
|
S DIR(0)="Y",DIR("B")="NO"
|
|
S DIR("A")="Are you sure you want to link this report back to the case"_$S(RAPRTSET:"s",1:"")
|
|
S DIR("?")="Answer ""Y"" to link this report back to the case(s) shown above."
|
|
D ^DIR K DIR
|
|
S:$D(DIRUT) RAXIT=1
|
|
S:'Y RAXIT=1
|
|
Q
|
|
RESTORE ; set Report Status to before delete value, link to case(s)
|
|
D SETFF(74,5,RARPT,RAPRVST)
|
|
W !!?3,"... Restored ",$P(RA74,U,1),"'s report status to: ",$$GET1^DIQ(74,+RARPT,5),"."
|
|
;
|
|
; set activity log record
|
|
S RAIENL="+1,"_RARPT_","
|
|
D SETALOG(RAIENL,"R",RAPRVST)
|
|
;
|
|
; link report to single case or all cases of a printset
|
|
I RAPRTSET D
|
|
. S RA1=""
|
|
. F S RA1=$O(RAMEMARR(RA1)) Q:RA1="" S $P(^RADPT(RADFN,"DT",RADTI,"P",RA1,0),U,17)=RARPT D MSG1(+RAMEMARR(RA1))
|
|
.Q
|
|
E S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,17)=RARPT D MSG1(RACN)
|
|
;
|
|
;Restore Primary and Secondary DX codes, Staff and Residents
|
|
;
|
|
;RAFLD is defined in SET70
|
|
F RAFLD=5,7,9 S RAPREV=$P(RALAST,U,RAFLD) D:RAPREV SET70(RAFLD)
|
|
; restore report status
|
|
W !!!?3,"** You need to edit the case"_$S(RAPRTSET:"s",1:"")_" to update the exam status. **"
|
|
Q
|
|
SET70(X) ; put back previous DX codes, Staff, Residents into case record
|
|
; assumes if no primary then no secondaries
|
|
K RAFDA,RAA
|
|
N RA1
|
|
S RAIENS=1_","_RAPRVIEN_","_RARPT_","
|
|
;
|
|
; X is the field number from subfile 74.01:
|
|
; 5 = BEFORE DELETION PRIM. DX CODE
|
|
; 7 = BEFORE DELETION PRIM. STAFF
|
|
; 9 = BEFORE DELETION PRIM. RESIDENT
|
|
;
|
|
; RAF1 = subfile number from file 74's activity log
|
|
; RAF2 = subfile number from file 70's secondaries
|
|
; RAF3 = subfile number pointed to from file 70's secondaries
|
|
; RAPIECE = piece in 70.03's 0 node
|
|
S RAF1=$S(X=5:74.16,X=7:74.18,X=9:74.19,1:"") Q:RAF1=""
|
|
S RAF2=$S(X=5:70.14,X=7:70.11,X=9:70.09,1:"") Q:RAF2=""
|
|
S RAF3=$$GET1^DID(RAF2,.01,"","POINTER")
|
|
; extract file number from RAF3
|
|
S RAF3=$TR(RAF3,$TR(RAF3,"0123456789."))
|
|
;piece number for Primary DX/Staff/Resident in 70.03
|
|
S RAPIECE=$S(X=5:13,X=7:15,X=9:12,1:"") Q:RAPIECE=""
|
|
S RAROOT=$$ROOT^DILFD(RAF1,RAIENS,1) ;closed root under file 74's Activity Log
|
|
;copy secondaries into RAA()
|
|
M RAA=@RAROOT
|
|
;
|
|
G:RAPRTSET PSET
|
|
;
|
|
; single case
|
|
;
|
|
; copy Primary into single case
|
|
S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",RAPIECE)=RAPREV
|
|
D FILE^DIE("","RAFDA","RAMSG")
|
|
I $D(RAMSG("DIERR")) D ERR4(RACN,$$GET1^DID(70.03,RAPIECE,"","LABEL"),$$GET1^DIQ(RAF3,RAPREV,.01))
|
|
E D MSG2(RACN,$$GET1^DID(70.03,RAPIECE,"","LABEL"),$$GET1^DIQ(RAF3,RAPREV,.01))
|
|
K RAFDA,RAMSG
|
|
;
|
|
Q:$O(RAA(0))'>0 ; no secondaries
|
|
;
|
|
;copy secondary items into single case
|
|
S RA1=0
|
|
F S RA1=$O(RAA(RA1)) Q:'RA1 S RAX=$G(RAA(RA1,0)) D:RAX
|
|
.S RAFDA(RAF2,"+2,"_RACNI_","_RADTI_","_RADFN_",",.01)=RAX
|
|
.D UPDATE^DIE(,"RAFDA",,"RAMSG")
|
|
.I $D(RAMSG("DIERR")) D ERR4(RACN,$$GET1^DID(RAF2,.01,"","LABEL"),$$GET1^DIQ(RAF3,RAX,.01))
|
|
.E D MSG2(RACN,$$GET1^DID(RAF2,.01,"","LABEL"),$$GET1^DIQ(RAF3,RAX,.01))
|
|
.K RAFDA,RAMSG
|
|
.Q
|
|
Q
|
|
;
|
|
; cases from printset
|
|
;
|
|
PSET ; copy Primary into cases of a printset
|
|
S RA1=0
|
|
F S RA1=$O(RAMEMARR(RA1)) Q:RA1="" D
|
|
.S RAFDA(70.03,RA1_","_RADTI_","_RADFN_",",RAPIECE)=RAPREV
|
|
.D FILE^DIE("","RAFDA","RAMSG")
|
|
.I $D(RAMSG("DIERR")) D ERR4(+RAMEMARR(RA1),$$GET1^DID(70.03,RAPIECE,"","LABEL"),$$GET1^DIQ(RAF3,RAPREV,.01))
|
|
.E D MSG2(+RAMEMARR(RA1),$$GET1^DID(70.03,RAPIECE,"","LABEL"),$$GET1^DIQ(RAF3,RAPREV,.01))
|
|
.K RAFDA,RAMSG
|
|
.Q:$O(RAA(0))'>0 ; no secondary DXs
|
|
.; copy secondaries into cases of a printset
|
|
.S RA2=0
|
|
.F S RA2=$O(RAA(RA2)) Q:'RA2 S RAX=$G(RAA(RA2,0)) D:RAX
|
|
..S RAFDA(RAF2,"+2,"_RA1_","_RADTI_","_RADFN_",",.01)=RAX
|
|
..D UPDATE^DIE(,"RAFDA",,"RAMSG")
|
|
..I $D(RAMSG("DIERR")) D ERR4(+RAMEMARR(RA1),$$GET1^DID(RAF2,.01,"","LABEL"),$$GET1^DIQ(RAF3,RAX,.01))
|
|
..E D MSG2(+RAMEMARR(RA1),$$GET1^DID(RAF2,.01,"","LABEL"),$$GET1^DIQ(RAF3,RAX,.01))
|
|
..K RAFDA,RAMSG
|
|
..Q
|
|
.Q
|
|
Q
|
|
SETFF(RA1,RA2,RA3,RA4,RA5) ;reset file's field value
|
|
;RA1 file number
|
|
;RA2 field number
|
|
;RA3 IEN in file
|
|
;RA4 field value to set in record IEN
|
|
;RA5 (optional), set to "E" for external
|
|
N RAFDA
|
|
S RAFDA(RA1,RA3_",",RA2)=RA4
|
|
I $G(RA5)="E" D FILE^DIE("E","RAFDA")
|
|
E D FILE^DIE("","RAFDA")
|
|
Q
|
|
SETALOG(RA1,RA2,RA3) ;set new record in Activity log 74.01
|
|
;RA1 ien string, eg., "+1,"_RARPT_","
|
|
;RA2 type of action
|
|
;RA3 current report status code
|
|
;
|
|
N RAFDA
|
|
S RAFDA(74.01,RA1,.01)=+$E($$NOW^XLFDT(),1,12)
|
|
S RAFDA(74.01,RA1,2)=RA2
|
|
S RAFDA(74.01,RA1,3)=$G(DUZ)
|
|
S:RA3 RAFDA(74.01,RA1,4)=RA3 ;only del rpt would have data here
|
|
D UPDATE^DIE(,"RAFDA")
|
|
Q
|
|
MSG1(X) ;
|
|
W !?3,"... Linked restored report to case no. ",X
|
|
Q
|
|
MSG2(X,Y,Z) ;
|
|
W !?3,"... Restored case ",X,"'s ",Y," to: ",Z
|
|
Q
|
|
ERR0 ;
|
|
W !,"Unable to determine case previously associated with this report."
|
|
S RAXIT=1
|
|
Q
|
|
ERR1 W !!,"Cannot determine previous report status.",!
|
|
S RAXIT=1
|
|
Q
|
|
ERR2(X,Y,Z) ;X=External short case No, Y=File no., Z=Field no.
|
|
W !,"Case #",X," already has ",$$GET1^DID(Y,Z,"","LABEL")
|
|
S RAXIT=1
|
|
Q
|
|
ERR3(X) ;
|
|
W !,"Case #",X," is already associated with a report!"
|
|
S RAXIT=1
|
|
Q
|
|
ERR4(X,Y,Z) ;
|
|
W !!?3,"Cannot restore case ",X,"'s ",Y," to: ",Z
|
|
Q
|
|
NOTDONE ;
|
|
W !!?3,"Restoration was not done."
|
|
; continue to clean up
|
|
FINISH ; clean up and exit
|
|
R !!!,"Press RETURN to exit. ",X:DTIME
|
|
K DIRUT,I
|
|
K RA1,RA2,RA3,RA4,RA5,RA18EX,RA70,RA74,RAA,RACMDATA
|
|
K RACN,RACNI,RADATE,RADFN,RADTE,RADTI,RADUZ,RAFDA,RAF1,RAF2,RAF3
|
|
K RAI,RAIENL,RAIENS,RAIENSUB,RALAST,RALCKFLG,RAMEMARR,RANME,RANODE
|
|
K RAOUT,RAPIECE,RAPRC,RAPRTSET,RAPRVIEN,RAPREV,RAPRVST,RAROOT,RARPT
|
|
K RASSN,RAST,RASUB70,RASUBY0,RAX,RAXIT,X,XY,Y,Z
|
|
Q
|
|
DISPLAY ; Display exam specific info, edit/enter the report
|
|
; adapted from routine RARTE
|
|
S RA18EX=0 ;P18 for quit if uparrow inside PUTTCOM
|
|
I '($D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))#2) D D Q1^RARTE5 QUIT
|
|
. W !!?2,"Case #: ",RACN," for ",RANME S RAXIT=1
|
|
. W !?2,"Procedure: '",$E(RAPRC,1,45),"' has been deleted"
|
|
. W !?2,"by another user!",$C(7)
|
|
. Q
|
|
;
|
|
S RAI="",$P(RAI,"-",80)="" W !,RAI
|
|
W !?1,"Name : ",$E(RANME,1,25),?40,"Pt ID : ",RASSN
|
|
W !?1,"Case No. : ",RACN,?18,"Exm. St: ",$E($P($G(^RA(72,+RAST,0)),"^"),1,12),?40,"Procedure : ",$E(RAPRC,1,25)
|
|
;check for contrast media; display if CM data exists (patch 45)
|
|
S RACMDATA=$$CMEDIA^RAUTL8(RADFN,RADTI,RACNI)
|
|
D:$L(RACMDATA) CMEDIA^RARTE(RACMDATA)
|
|
K RACMDATA
|
|
S RA18EX=$$PUTTCOM2^RAUTL11(RADFN,RADTI,RACN," Tech.Comment: ",15,70,-1,0) ;P18
|
|
I RA18EX=-1 Q ;P18
|
|
;
|
|
D:'$D(RAPRTSET) EN2^RAUTL20(.RAMEMARR)
|
|
; if printset, display cases and continue on to display Exam Date
|
|
I RAPRTSET D
|
|
. S RA1=""
|
|
. F S RA1=$O(RAMEMARR(RA1)) Q:RA1=""!(RA18EX=-1) I RA1'=RACNI D
|
|
.. W !,?1,"Case No. : ",+RAMEMARR(RA1)
|
|
.. W:$P(RAMEMARR(RA1),"^",4)]"" ?18,"Exm. St: ",$E($P($G(^RA(72,$P(RAMEMARR(RA1),"^",4),0)),"^"),1,12)
|
|
.. W ?40,"Procedure : ",$E($P($G(^RAMIS(71,+$P(RAMEMARR(RA1),"^",2),0)),"^"),1,26)
|
|
..;check printset for contrast media; display if CM data exists
|
|
..S RACMDATA=$$CMEDIA^RAUTL8(RADFN,RADTI,RA1)
|
|
..D:$L(RACMDATA) CMEDIA^RARTE(RACMDATA)
|
|
..K RACMDATA
|
|
.. S RA18EX=$$PUTTCOM2^RAUTL11(RADFN,RADTI,+RAMEMARR(RA1)," Tech.Comment: ",15,70,-1,0) Q:RA18EX=-1 ;P18
|
|
.. Q
|
|
. Q
|
|
;continue display
|
|
I RA18EX=-1 Q ;P18
|
|
S Y(0)=RASUBY0
|
|
S RAIENS=RACNI_","_RADTI_","_RADFN_","
|
|
D GETS^DIQ(70.03,RAIENS,"14;175*","E","RAOUT")
|
|
W !?1,"Exam Date: ",RADATE,?40,"Technologist: "
|
|
S RAIENSUB=$O(RAOUT(70.12,0))
|
|
W:RAIENSUB]"" $E($G(RAOUT(70.12,RAIENSUB,.01,"E")),1,25)
|
|
W !?40,"Req Phys : "
|
|
W $E($G(RAOUT(70.03,RAIENS,14,"E")),1,25)
|
|
W !,RAI
|
|
Q
|
|
LOCK(X,Y) ; Lock the data global
|
|
; uses var DILOCKTM, code taken from rtn RAUTL12
|
|
; 'X' is the global root
|
|
; 'Y' is the record number
|
|
N RALCKFLG,XY
|
|
S RADUZ=+$G(DUZ),RALCKFLG=0,XY=X_Y
|
|
L +@(XY_")"):DILOCKTM
|
|
I '$T S RALCKFLG=1 D
|
|
. W !?5,"This record is being edited by another user."
|
|
. W !?5,"Try again later!",$C(7)
|
|
. Q
|
|
E D
|
|
. S ^TMP("RAD LOCKS",$J,RADUZ,X,Y)=""
|
|
. Q
|
|
Q RALCKFLG
|
|
INTRO ;
|
|
;; +--------------------------------------------------------+
|
|
;; | |
|
|
;; | This option is for restoring a deleted report. |
|
|
;; | |
|
|
;; +--------------------------------------------------------+
|