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