Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RARTE6

RARTE6.m

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