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

RARTE7.m

Go to the documentation of this file.
  1. RARTE7 ;HISC/SM continuation - Delete a Report, Outside Rpt misc;10/10/08 16:05
  1. ;;5.0;Radiology/Nuclear Medicine;**56,95,97,103**;Mar 16, 1998;Build 2
  1. ;Supported IA #2053 NOW^XLFDT, FILE^DIE, UPDATE^DIE
  1. ;Supported IA #2052 GET1^DID
  1. ;Supported IA #2055 ROOT^DILFD
  1. ;
  1. ;04/06/2010 BP/KAM RA*5*103 Remedy Ticket 324541 Outside Reports does
  1. ; not generate Imaging Results CPRS Alert
  1. Q
  1. MARKDEL ; set field 5 to "X" to mark rpt as deleted
  1. ; also update activity log, send report deletion bulletin, store then delete
  1. ; associated DX, Staff, Resident data
  1. N DA,DIK,RA1,RA2,RAA,RAFDA,RAIEN2,RAIENDX,RAIENL,RACLOAK
  1. N RAMEMARR,RAMSG,RAOUT,RAPRTSET,RASAVE,RAX,RA7003
  1. N RAF1,RAF2,RAF3,RAIENS
  1. ;
  1. ;PART 1 - mark report as deleted
  1. ;
  1. S RASAVE=$P(^RARPT(RAIEN,0),U,5) ;save current rpt status
  1. S RAFDA(74,RAIEN_",",5)="X" ;change rpt status
  1. D FILE^DIE("","RAFDA")
  1. K RAFDA
  1. ;
  1. ;PART 2 - add new entry to ACTIVITY LOG and store primary data
  1. ;
  1. S RA7003=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
  1. S RAIENL="+1,"_RAIEN_","
  1. S RAFDA(74.01,RAIENL,.01)=+$E($$NOW^XLFDT(),1,12)
  1. S RAFDA(74.01,RAIENL,2)="X"
  1. S RAFDA(74.01,RAIENL,3)=$G(DUZ)
  1. S RAFDA(74.01,RAIENL,4)=RASAVE ;store before-delete rpt status
  1. S RAFDA(74.01,RAIENL,5)=$P(RA7003,U,13) ; store Prim DX code
  1. S RAFDA(74.01,RAIENL,7)=$P(RA7003,U,15) ; store Prim Staff
  1. S RAFDA(74.01,RAIENL,9)=$P(RA7003,U,12) ; store Prim Resident
  1. D UPDATE^DIE(,"RAFDA","RAOUT","RAMSG")
  1. W:$D(RAMSG("DIERR")) !!,"Could not update deleted Report's Activity Log."
  1. K RAFDA
  1. ;
  1. ; store Secondary DXs/Staff/Residents under this ACTIVITY LOG
  1. ; if printset, no need to store each case's sec DX, they should be same
  1. Q:'RAOUT(1) ;no record set in 74.01
  1. S RAIEN2=RAOUT(1)
  1. ;
  1. ;PART 3 - send report deletion bulletin
  1. ;
  1. D CLOAK^RABUL3 ; requires RAIEN and RAIEN2
  1. ;
  1. ;PART 4 - store secondary DX, Staff, Resident data
  1. ;
  1. ;don't need separate logic for printset for storing identical data
  1. F RAFLD=5,7,9 D SET7401(RAFLD)
  1. ;
  1. ;PART 5 - remove Prim. and Sec. DX, Staff, Resident from case record
  1. ;
  1. D EN2^RAUTL20(.RAMEMARR) ; is case part of a printset?
  1. G:RAPRTSET PSET
  1. ;
  1. ; single case
  1. ;
  1. ; delete primaries
  1. S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",13)="@" ;Prim. DX
  1. S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",15)="@" ;Prim. Staff
  1. S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",12)="@" ;Prim. Resident
  1. D FILE^DIE("","RAFDA")
  1. K RAFDA
  1. ;
  1. ; delete secondaries
  1. F RASUB=70.14,70.11,70.09 D KILSEC(RASUB,RACNI)
  1. Q
  1. ;
  1. ; cases from printset
  1. ;
  1. PSET ;delete primary and secondary data
  1. S RA1=0
  1. F S RA1=$O(RAMEMARR(RA1)) Q:RA1="" D
  1. .; delete primary from 70.03
  1. .S RAFDA(70.03,RA1_","_RADTI_","_RADFN_",",13)="@" ;Prim. DX
  1. .S RAFDA(70.03,RA1_","_RADTI_","_RADFN_",",15)="@" ;Prim. Staff
  1. .S RAFDA(70.03,RA1_","_RADTI_","_RADFN_",",12)="@" ;Prim. Resident
  1. .D FILE^DIE("","RAFDA")
  1. .K RAFDA
  1. .F RASUB=70.14,70.11,70.09 D KILSEC(RASUB,RA1)
  1. Q
  1. KILSEC(RAF2,RAC1) ;kill secondary data
  1. ;RAF2 subfile number from file 70's secondaries
  1. ;RAC1 ien for subfile 70.03
  1. N RAA,RAROOT
  1. K DA,DIK
  1. S RAIENS=1_","_RAC1_","_RADTI_","_RADFN_","
  1. S RAROOT=$$ROOT^DILFD(RAF2,RAIENS,1) ; closed root
  1. M RAA=@RAROOT
  1. Q:$O(RAA(0))'>0 ;no secondaries
  1. D DA^DILF(RAIENS,.DA) ;get the DA array
  1. S DIK=$$ROOT^DILFD(RAF2,RAIENS)
  1. S RA2=0
  1. F S RA2=$O(RAA(RA2)) Q:'RA2 S DA=RA2 D ^DIK
  1. K DIK
  1. Q
  1. SET7401(X) ; use this for DX, Staff, Resident secondaries
  1. ; set activity log's subfiles to store any secondaries
  1. K RAFDA,RAMSG,RAA
  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. ;
  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 RAIENS=1_","_RACNI_","_RADTI_","_RADFN_","
  1. S RAROOT=$$ROOT^DILFD(RAF2,RAIENS,1) ; closed root, file 70's secondaries
  1. M RAA=@RAROOT
  1. Q:$O(RAA(0))'>0 ; no secondaries
  1. ;
  1. S RAF3=$$GET1^DID(RAF2,.01,"","POINTER")
  1. ; extract file number from RAF3
  1. S RAF3=$TR(RAF3,$TR(RAF3,"0123456789."))
  1. ;
  1. ; store Secondary DXs
  1. S RA1=0
  1. S RAIENDX="+2,"_RAIEN2_","_RAIEN_","
  1. F S RA1=$O(RAA(RA1)) Q:'RA1 S RAX=$G(RAA(RA1,0)) D:RAX
  1. .S RAFDA(RAF1,RAIENDX,.01)=RAX
  1. .D UPDATE^DIE(,"RAFDA",,"RAMSG")
  1. .W:$D(RAMSG("DIERR")) !!,"Could not store ",$$GET1^DID(RAF2,.01,"","LABEL"),"'s value: ",$$GET1^DIQ(RAF3,RAX,.01)
  1. .K RAFDA,RAMSG
  1. .Q
  1. Q
  1. ANYDX(ARRAY) ; called from RARTE5
  1. ; input ARRAY name to store all DXs for this case
  1. ; output:
  1. ; =1 if one or more diag codes
  1. ; =0 if no diag code
  1. ; ARRAY() stores diag codes as merged from case
  1. Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI))
  1. K ARRAY
  1. M ARRAY=^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX") ;Sec Diags
  1. S ARRAY(9999,0)=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13) ;Prim Diag
  1. I $O(ARRAY(0)) Q 1
  1. Q 0
  1. ;
  1. ALERT ; for Outside Report, ck if new/changed diags require alert
  1. ; this is called from RARTE5 each time an outside report is edited
  1. Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI))
  1. N RASAVE,RAY3,X
  1. ; set RASAVE() for OENOTE^RAUTL00
  1. S RASAVE("RADFN")=RADFN,RASAVE("RADTI")=RADTI,RASAVE("RACNI")=RACNI
  1. ;
  1. N I
  1. Q:(RANY1=0)&(RANY2=0) ;no diags before and after edit
  1. S I=0
  1. ; loop RAA2
  1. F S I=$O(RAA2(I)) Q:'I K:RAA2(I,0)=$G(RAA1(I,0)) RAA2(I,0)
  1. ;04/06/2010 BP/KAM RA*5*103 Rem Tkt 324541 Commented out next line
  1. ;Q:'$O(RAA2(0))
  1. K RAAB
  1. S I=0 F S I=$O(RAA2(I)) Q:'I D
  1. .I $D(^RA(78.3,+RAA2(I,0),0)),($P(^(0),U,4)="y") S RAAB=1
  1. .Q
  1. ; invoke notification for either condition:
  1. ; (1) new EF report is made --> non-critical imaging alert
  1. ; (2) old/new EF report w abnormal DX --> abnormal alert
  1. ; either of the above alert may be from an amended report or not
  1. I $G(RAAB)!RAFIRST D
  1. .S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
  1. .S X=RAY3 ; X is input to OENOTE
  1. .D OENOTE^RAUTL00
  1. Q