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

RARTE2.m

Go to the documentation of this file.
  1. RARTE2 ;HISC/SWM,GJC-Edit/Delete a Report ; Feb 09, 2021@12:26:05
  1. ;;5.0;Radiology/Nuclear Medicine;**10,31,47,124,175**;Mar 16, 1998;Build 2
  1. ; known vars-->RADFN,RACNI,RADTI,RARPT,RARPTN
  1. ;
  1. ;Routine IA Type
  1. ;-------------------------------------
  1. ; ^DIR 10026 (S)
  1. ; APPERROR^%ZTER 1621 (S)
  1. ; OWNSKEY^XUSRB 3277 (S)
  1. ;
  1. PTR ; if the current study is the master study for
  1. ; the print set the accession of the master study
  1. ; is the .01 value of the master pset report record.
  1. ; All secondary studies will have their accession
  1. ; numbers filed in the OTHER CASE# multiple under
  1. ; that master pset report record.
  1. ;
  1. ;RARPTN: the value of the .01 field of our master pset
  1. ; report record (accession #)
  1. ;
  1. S RAXIT=0
  1. I '$D(RADFN)!'$D(RACNI)!'$D(RADTI)!'$D(RARPT)!'$D(RARPTN) D Q
  1. . S RAXIT=1 Q:$G(RARIC)
  1. . I '$D(RAQUIET) W !!,$C(7),"Missing data (routine RARTE2)",! S RAOUT=$$EOS^RAUTL5() Q
  1. . S RAERR="Missing data needed by routine RARTE2"
  1. . Q
  1. ;
  1. PTR2 ;find the descendent, if part of the pset build accession # into our result
  1. ;array iff they pass the conditions enumerated below.
  1. ;from RAHLO1: RARPTN=RALONGCN
  1. ;
  1. N RAO1,RA1ARY,RACCSTR,RARPTONCAN
  1. ;RAO1 - study IEN (think RACNI)
  1. ;RACCSTR - front end of the accession (excludes case #) in this part
  1. ; of the code (changes to full accession # in PTR3)
  1. ;RA1ARY - this will be the array where our accession #s are stored
  1. ; RA1ARY(RAO1,accession #)=""
  1. ;RARPTONCAN - allow rpts on canceled cases? '1' for yes, else '0'
  1. ;
  1. S RACCSTR=$P(RARPTN,"-",1,($L(RARPTN,"-")-1)) ;Ex: 141-040618 -or- 040618
  1. ;--- RA5P175
  1. ;RAMDV is expected to be .1 node of file #79 division
  1. ;record with the pieces having values of: '1','0' or ""
  1. S RARPTONCAN=+$P($G(RAMDV),U,22)
  1. ;---
  1. ;save off the accession # stored in the .01 field of the report
  1. ;we do not want this accession # set in the OTHER CASE# multiple
  1. S RA1ARY(0,RARPTN)=""
  1. ;
  1. S RAO1=0 K RAOX
  1. F S RAO1=$O(^RADPT(RADFN,"DT",RADTI,"P",RAO1)) Q:'RAO1 D
  1. .S RAO1(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RAO1,0))
  1. .;get the order # of the exam status for this study RAOX(3)
  1. .S RAOX(3)=$P(^RA(72,+$P(RAO1(0),U,3),0),U,3)
  1. .;--- RA5P175
  1. .;Condition 1: if a pset, if in foreground, study canceled
  1. .;& allow rpts on canceled cases = 'no' ask the user if they
  1. .;want to tie the report to the canceled exam.
  1. .;Note: RA MGR key is required in order to be asked.
  1. .I $$SILENT()=1,(RAOX(3)=0),(RARPTONCAN=0),($$OWNSKEY()=0) QUIT ;no RA MGR key
  1. .I $$SILENT()=1,(RAOX(3)=0),(RARPTONCAN=0),($$OWNSKEY()) Q:$$ASK()'=1
  1. .;--- RA5P175
  1. .;Condition 2: if in background, study canceled & allow
  1. .;rpts on canceled cases = 'no'
  1. .I $$SILENT()=0,(RAOX(3)=0),(RARPTONCAN=0) QUIT
  1. .;---
  1. .;set the report pointer for the study in question
  1. .S $P(^RADPT(RADFN,"DT",RADTI,"P",RAO1,0),U,17)=RARPT
  1. .;build the accession number: +RAO1(0) = case number
  1. .S RAOX=RACCSTR_"-"_+RAO1(0)
  1. .I $P(RAO1(0),U,25)=2,('$D(RA1ARY(0,RAOX))#2) S RA1ARY(RAO1,RAOX)=""
  1. .Q
  1. K RAOX
  1. ;
  1. PTR3 ; -RAO1: reused for $O subscript (think RACNI)
  1. ; -RACCSTR: now represents the full accession #
  1. ; Ex: 141-040618-12345 -or- 040618-12345
  1. ; -RARPT: record # of RIS report in file #74
  1. ;
  1. S RAO1=0 F S RAO1=$O(RA1ARY(RAO1)) Q:'RAO1 D
  1. .S RACCSTR=$O(RA1ARY(RAO1,"")) ;accession #
  1. .; do not file this accession # into the
  1. .; OTHER CASE# (#4.5) multiple if it already exists
  1. .; *** Milwaukee RIS issue: .01 overwritten & duplicate
  1. .; accessions in OTHER CASE# mult (124 T1) ***
  1. .D:($D(^RARPT("B",RACCSTR,RARPT))=0) INSERT
  1. .Q
  1. ;
  1. ;note: * I $G(RARIC) REPORT TEXT (70.03;17) is set in routine RARIC
  1. ; * I $D(RAQUIET) REPORT TEXT is set in routine RAHLO1
  1. ; * through the backdoor, REPORT TEXT is set in tag^routine(s):
  1. ; - LOCK^RARTE4
  1. ; - LOCK^RARTE5
  1. ;
  1. ; + noted b/c there was a hard set of the REPORT TEXT field in this code prior
  1. ; to RA*5.0*124.
  1. Q
  1. ;
  1. INSERT ; add subrec to file #74's subfile #74.05
  1. N RAFDA,RAIEN,RAMSG
  1. S RAIEN="?+1,"_RARPT_",",RAFDA(74.05,RAIEN,.01)=RACCSTR
  1. D UPDATE^DIE("","RAFDA","RAIEN","RAMSG")
  1. I $D(RAMSG) D Q
  1. . S RAXIT=1 Q:$G(RARIC)
  1. . I '$D(RAQUIET) W !!,$C(7),"Error encountered while setting sub-records (routine RARTE2)",! S RAOUT=$$EOS^RAUTL5() Q ;error detected
  1. . S RAERR="Error encountered while setting sub-recs from RARTE2"
  1. Q
  1. ;
  1. DEL17(RAIEN) ;del other print set members' pointer to #74
  1. Q:'$D(RADFN)!('$D(RADTI))
  1. N RA4,RA1 D EN3^RAUTL20(.RA4)
  1. Q:'$O(RA4(0))
  1. S RA1=""
  1. D18 S RA1=$O(RA4(RA1)) Q:RA1=""
  1. ; kill xrefs, if any, for file #70's REPORT TEXT
  1. S DA(2)=RADFN,DA(1)=RADTI,DA=RA1
  1. ; if this exam's piece 17 doesn't match RAIEN, then don't remove pc17
  1. I $P($G(^RADPT(RADFN,"DT",RADTI,"P",RA1,0)),"^",17)'=RAIEN G D18
  1. D ENKILL^RAXREF(70.03,17,RAIEN,.DA)
  1. ; set REPORT TEXT to null
  1. S:$D(^RADPT(RADFN,"DT",RADTI,"P",RA1,0)) $P(^(0),"^",17)=""
  1. G D18
  1. COPY ;copy physicians and diagnoses
  1. Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI))!('$D(RAMEMARR))!('$D(RADRS))
  1. W !!,"... now copying ",$S(RADRS=1:"Diagnostic Codes",1:"Staff & Resident data")," to other cases in this print set ...",!
  1. N RA1,RA2,RA3
  1. N RA1PR,RA1PS ;prim res/staff
  1. N RA1SR,RA1SS ; sec res/staff arrays--(ien subfile #70.11)=ien file #200
  1. N RA1PD,RA1SD ; prim diag, then sec diags array
  1. N RAFDA,RAIEN,RAMSG
  1. ;prim res, prim staff, prim diag
  1. S RA1=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0) S:RADRS=2 RA1PR=$P(RA1,"^",12),RA1PS=$P(RA1,"^",15) S:RADRS=1 RA1PD=$P(RA1,"^",13)
  1. ;sec residents
  1. I RADRS=2,$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",0)) S RA1=0 F S RA1=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",RA1)) Q:+RA1'=RA1 S RA1SR(RA1)=+^(RA1,0)
  1. ;sec staff
  1. I RADRS=2,$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",0)) S RA1=0 F S RA1=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",RA1)) Q:+RA1'=RA1 S RA1SS(RA1)=+^(RA1,0)
  1. ;sec diagnoses
  1. I RADRS=1,$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0)) S RA1=0 F S RA1=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",RA1)) Q:+RA1'=RA1 S RA1SD(RA1)=+^(RA1,0)
  1. ;loop thru other cases of this printset
  1. S RA1=0
  1. COPYLOOP S RA1=$O(RAMEMARR(RA1)) G:RA1="" COPYREF G:RA1=RACNI COPYLOOP ;skip what's done already
  1. ;
  1. ; copy primary staff and resident via Fileman
  1. I RADRS=2 D
  1. . S DA(2)=RADFN,DA(1)=RADTI,DA=RA1
  1. . S DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"","
  1. . S DR="12////"_RA1PR_";15////"_RA1PS
  1. . D ^DIE K DA,DIE,DR ; no locking
  1. . Q
  1. ;
  1. ; copy primary diagnostic code via Fileman
  1. I RADRS=1 D
  1. . S DA(2)=RADFN,DA(1)=RADTI,DA=RA1
  1. . S DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"","
  1. . S DR="13////"_RA1PD
  1. . D ^DIE K DA,DIE,DR ; no locking
  1. . Q
  1. ;
  1. S RA2=RA1_","_RADTI_","_RADFN ;stem for dataserver call
  1. S DA(3)=RADFN,DA(2)=RADTI,DA(1)=RA1 ;base vars for DIK call
  1. I RADRS=2 S RA3=0 D KIL3 G:RAXIT Q ; sec res
  1. I RADRS=2 S RA3=0 D KIL4 G:RAXIT Q ; sec staff
  1. I RADRS=1 S RA3=0 D KIL5 G:RAXIT Q ; sec diag
  1. G COPYLOOP
  1. KIL3 S RA3=$O(^RADPT(RADFN,"DT",RADTI,"P",RA1,"SRR",RA3)) G:RA3="" COPY3
  1. S DA=RA3
  1. S DIK="^RADPT("_DA(3)_",""DT"","_DA(2)_",""P"","_DA(1)_",""SRR"","
  1. D ^DIK
  1. G KIL3
  1. COPY3 K RAFDA,RAIEN,RAMSG S RA3=$O(RA1SR(RA3)) Q:'RA3 Q:RAXIT
  1. UP3 ;
  1. S RAFDA(70.09,"?+2,"_RA2_",",.01)=RA1SR(RA3)
  1. D UPDATE^DIE("","RAFDA","RAIEN","RAMSG") G:'$D(RAMSG) COPY3
  1. S RAXIT=1 W !!,$C(7),"Error encountered while in adding rec ",RA3," to sub-file 70.09" Q
  1. KIL4 S RA3=$O(^RADPT(RADFN,"DT",RADTI,"P",RA1,"SSR",RA3)) G:RA3="" COPY4
  1. S DA=RA3
  1. S DIK="^RADPT("_DA(3)_",""DT"","_DA(2)_",""P"","_DA(1)_",""SSR"","
  1. D ^DIK
  1. G KIL4
  1. COPY4 K RAFDA,RAIEN,RAMSG S RA3=$O(RA1SS(RA3)) Q:'RA3 Q:RAXIT
  1. UP4 ;
  1. S RAFDA(70.11,"?+2,"_RA2_",",.01)=RA1SS(RA3)
  1. D UPDATE^DIE("","RAFDA","RAIEN","RAMSG") G:'$D(RAMSG) COPY4
  1. S RAXIT=1 W !!,$C(7),"Error encountered while in adding rec ",RA3," to sub-file 70.11" Q
  1. KIL5 S RA3=$O(^RADPT(RADFN,"DT",RADTI,"P",RA1,"DX",RA3)) G:RA3="" COPY5
  1. S DA=RA3
  1. S DIK="^RADPT("_DA(3)_",""DT"","_DA(2)_",""P"","_DA(1)_",""DX"","
  1. D ^DIK
  1. G KIL5
  1. COPY5 K RAFDA,RAIEN,RAMSG S RA3=$O(RA1SD(RA3)) Q:'RA3 Q:RAXIT
  1. UP5 ;
  1. S RAFDA(70.14,"?+2,"_RA2_",",.01)=RA1SD(RA3)
  1. D UPDATE^DIE("","RAFDA","RAIEN","RAMSG") G:'$D(RAMSG) COPY5
  1. S RAXIT=1 W !!,$C(7),"Error encountered while in adding rec ",RA3," to sub-file 70.14" Q
  1. COPYREF ; clear out Fileman vars and quit
  1. K DA,DIK
  1. Q ; don't need to re-xref again
  1. Q K DA Q
  1. ;
  1. SILENT() ;ask to include canceled cases if interactive
  1. ;RARIC: set in CREATE^RARIC
  1. ;RAQUIET: set in the RIS' HL7 bridge routine
  1. Q:$G(RARIC)!($D(RAQUIET)) 0
  1. Q 1
  1. ;
  1. ASK() ;include canceled case in report?
  1. N DIRUT,DUOUT,DTOUT,DIR,X,Y,RAX
  1. S DIR(0)="Y",DIR("B")="No"
  1. S DIR("A",1)="Case "_+$P(RAO1(0),U)_" on this printset has been canceled."
  1. S DIR("A")="Do you want to include it in the report anyway" D ^DIR
  1. I $D(DIRUT) S Y=-1
  1. S RAX=$S(Y=1:"In",1:"Ex")_"clude case "_+$P(RAO1(0),U)
  1. W !!,RAX
  1. Q Y ;'1' for yes, '0' for no
  1. ;
  1. OWNSKEY() ;does this user have the RA MGR key?
  1. ;Input variable: none; DUZ must be defined
  1. ;Output: BOOL(0) - Returns a subscripted output where
  1. ; 1 - User owns key.
  1. ; 0 - DUZ not defined or key not found.
  1. ;
  1. Q:$D(DUZ)#2=0 0
  1. N BOOL D OWNSKEY^XUSRB(.BOOL,"RA MGR",DUZ)
  1. Q BOOL(0)
  1. ;