- 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 Feb 19, 2025@00:06:43 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 ;