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

RAUTL3.m

Go to the documentation of this file.
  1. RAUTL3 ;HISC/CAH,FPT,GJC AISC/SAW-Utility for Callable Entry Points ;4/1/97 10:04
  1. ;;5.0;Radiology/Nuclear Medicine;**26,47**;Mar 16, 1998;Build 21
  1. EN1 ;ENTRY POINT FOR AMIE CALL
  1. ;Requires four input variables
  1. ; DFN = Patient internal entry number
  1. ; Date range for report in Fileman internal format
  1. ; RABDT = Beginning Date (time optional)
  1. ; RAEDT = Ending Date (time optional)
  1. ; Exam locations (from file 44, Hospital Location) that are to be
  1. ; included in the report
  1. ; RAHLOC = A string of internal entry numbers for locations
  1. ; Each location separated by ^ and RAHLOC must begin
  1. ; and end with an ^ (e.g., RAHLOC=^3^ or RAHLOC=^56^75^)
  1. ; These are REQUESTING locations, not imaging locations
  1. ;
  1. I '$D(DFN)!('$D(RAHLOC))!('$D(RABDT))!('$D(RAEDT)) W !!,"Required variables are not defined. Unable to continue.",*7 Q
  1. S RAMIE=1 F RAPTR=RABDT-.0000001:0 S RAPTR=$O(^RADPT(DFN,"DT","B",RAPTR)) Q:RAPTR'>0!(RAPTR>RAEDT) S RAPTR1=$O(^(RAPTR,0)) I RAPTR1 F RAPTR2=0:0 S RAPTR2=$O(^RADPT(DFN,"DT",RAPTR1,"P",RAPTR2)) Q:RAPTR2'>0 I $D(^(RAPTR2,0)) S RAEX=^(0) D CHK
  1. K RACNI,RAEX,RAII,RAK,RAMDIV,RAMDV,RAMLC,RAMIE,RANUM,RAPT1,RAPTR,RAPTR1,RAPTR2,RASSN,RAST Q
  1. CHK I $P(RAEX,U,17),RAHLOC[(U_$P(RAEX,U,22)_U) S RAST=$S($D(^RARPT($P(RAEX,"^",17),0)):^(0),1:"") I "VR"[$P(RAST,"^",5) S RARPT=$P(RAEX,"^",17),RAPT1=1 D ^RARTR F RAK=0:0 S RAK=$O(^RA(78.7,RAK)) Q:RAK'>0 I $D(^(RAK,0)) K @$P(^(0),"^",5)
  1. Q
  1. SIGNON ;Check the # of reports to either pre-verify of verify.
  1. Q:'$D(DUZ)#2 N RA74,X0,X1,Y1 S (X0,X1,Y1)=0
  1. ; first, tabulate # (Y1) of reports to pre-verify (if any)
  1. F S X0=$O(^RARPT("ARES",DUZ,X0)) Q:X0'>0 D
  1. . S RA74=$G(^RARPT(X0,0))
  1. . Q:$$STUB^RAEDCN1(X0) ; skip stub report 031501
  1. . Q:$P(RA74,"^",5)="V" ; skip if already verified
  1. . S:$P(RA74,"^",12)']"" Y1=Y1+1
  1. . Q
  1. S:Y1 X0="!*** You have "_Y1_" imaging report"_$S(Y1>1:"s",1:"")_" to pre-verify. ***"
  1. D:Y1 SET^XUS1A(X0)
  1. ; next tabulate # (X1) of reports to verify (if any)
  1. S X0=0 F S X0=$O(^RARPT("ASTF",DUZ,X0)) Q:X0'>0 D
  1. . S RA74=$G(^RARPT(X0,0))
  1. . Q:$$STUB^RAEDCN1(X0) ; skip stub report 031501
  1. . Q:$P(RA74,"^",5)="V" ; skip if already verified
  1. . S X1=X1+1
  1. Q:X1'>0
  1. S X0="!*** You have "_X1_" imaging report"_$S(X1>1:"s",1:"")_" to verify. ***"
  1. D SET^XUS1A(X0)
  1. Q
  1. UPDT(RANODE) ; Delete blank lines for Rad/Nuc Med Word Processing fields.
  1. ; These 'blank' consist of nothing more than spaces.
  1. ; 'RANODE' is the data node to be examined: i.e, for Clinical History
  1. ; in Rad/Nuc Med Orders (75.1) RANODE="^RAO(75.1,"_DA_",H,"
  1. ; -or in Rad/Nuc Med Reports (74) RANODE="^RARPT(DA_",R,"
  1. ;
  1. N RA0,RACNT,RAI,RATCNT,RAXIT,RAY
  1. S (RACNT,RATCNT,RAXIT)=0 S RAI=999999999
  1. S RAY=$G(@(RANODE_"0)")),RAY(4)=+$P(RAY,"^",4) Q:'RAY(4)
  1. F S RAI=$O(@(RANODE_RAI_")"),-1) Q:RAI'>0 D Q:RAXIT
  1. . S RA0=$G(@(RANODE_RAI_",0)"))
  1. . I RA0?1.999" " D
  1. .. K @(RANODE_RAI_",0)") S RACNT=RACNT+1
  1. . E S RAXIT=1
  1. . Q
  1. I RACNT D
  1. . S RATCNT=RAY(4)-RACNT
  1. . S @(RANODE_"0)")="^^"_RATCNT_"^"_RATCNT_"^"_$S($D(DT)#2:DT,1:$$DT^XLFDT())
  1. . Q
  1. Q
  1. ;
  1. GETLCN() ;Build & return a long case number (accession) for a live case.
  1. ;Called from File: 78.7; field: 100; Record: LONG CASE NUMBER (p47)
  1. ;
  1. ;input: RADFN -DFN of the patient
  1. ; RADTI -inverse date/time of the exam
  1. ; RACNI -the IEN of the case record (70.03)
  1. ; RAMDIV-Division (File: 79); derived from sign-on location
  1. ; Note: all have a global scope; all are expected to exist
  1. ;
  1. ; RAY2 -zero node of the REGISTERED EXAMS subfile (70.02)
  1. ; RAY3 -zero node of the EXAMINATIONS subfile (70.03)
  1. ;
  1. ; RAY2 & RAY3 may exist depending on the option executed. If RAY2 & RAY3 do not exist
  1. ; use RASAV2 & RASAV3 defined when RA REG is executed.
  1. ;
  1. ; Site Specific Accession Number (SSAN)
  1. ;
  1. N RAX S RAX=""
  1. I '$D(RAY2)#2 N RAY2 S RAY2=$G(RASAV2)
  1. I '$D(RAY3)#2 N RAY3 S RAY3=$G(RASAV3)
  1. I $$USESSAN^RAHLRU1() D ;if true get SSAN
  1. .;format: 578-081194-12345
  1. .S RAX=$$ACCNUM^RAAPI(RADFN,RADTI,RACNI) Q
  1. ;
  1. E D ;else get original accession
  1. .;format: 081194-12345
  1. .S RAX=$TR($$FMTE^XLFDT(($P(RAY2,"^")\1),"2F")," /","0")_"-"_+RAY3 Q
  1. ;
  1. Q RAX
  1. ;