- RARIC1 ;HISC/GJC-Check to see if Imaging package exists ;3/4/96 15:43
- ;;5.0;Radiology/Nuclear Medicine;**23,93**;Mar 16, 1998;Build 3
- ; 07/15/2008 BAY/KAM rem call 249750 RA*5*93 Correct DIK Calls
- ;
- ; API's STUFPHY and DELIMGPT are supported by DBIA#3317
- ;
- IMAGE() ; check to see if Imaging package exists
- ; called from RACNLU, RAPTLU and RART1
- ; 1 = exists
- ; 0 = doesn't exist
- S X="MAGBAPI" X ^%ZOSF("TEST") I '$T Q 0
- S X="MAGGTIA" X ^%ZOSF("TEST") I '$T Q 0
- Q $S($O(^MAG(2005,0)):1,1:0)
- ;
- ;
- STUFPHY(RAVERF,RASR,RARTN) ; stuff physician duz
- ;RASR should be rtn MAGJUPD1's RIST, =15 if staff, =12 if resident
- ;RAVERF=duz of physician (primary staff or primary resident)
- S RARTN="STUFPHY called"
- I '$D(DA(2))!'$D(DA(1))!'($D(DA)#2) S RARTN="Missing DA references" Q
- I 'RASR S RARTN="Missing RASR value" Q
- N RAERR,RAFLD,RAMDIV,RAMDV,RAMLC,RAESIG,RACOD
- ;
- ; check loc access
- S RACOD=$S(RASR=15:"S",RASR=12:"R",1:"")
- I RACOD="" S RARTN="Can't determine staff/resident code" Q
- I '$$SCRN^RAUTL8(.DA,RACOD,RAVERF,"PRI") S RARTN="Failed loc access" Q
- ;
- ; check verifier access
- I $D(^RADPT(DA(2),"DT",DA(1),0)) S RAMDIV=^(0),RAMLC=+$P(RAMDIV,"^",4),RAMDIV=+$P(RAMDIV,"^",3),RAMDV=$S($D(^RA(79,RAMDIV,.1)):^(.1),1:""),RAMDV=$S(RAMDV="":RAMDV,1:$TR(RAMDV,"YyNn",1100))
- I '$D(RAMDV) S RARTN="Can't determine RAMDV" Q
- D VERCHK^RAHLO3 ;returns RAERR text string
- I $G(RAERR)]"" S RARTN="Failed verifier: "_RAERR Q
- ;
- ; stuff data
- S DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"","
- S DR=RASR_"////"_RAVERF D ^DIE K DI,DIC,DE,DQ,DIE,DR
- S RARTN=1
- ;
- ;delete 2nd staff/resident if it matches the primary staff/resident
- S RAFLD=$S(RASR=15:60,RASR=12:70,1:"")
- I 'RAFLD K DA Q ;can't determine secondary field to check/delete
- D EN^RAUTL8(RAVERF,RAFLD,.DA)
- K DA
- Q
- DELIMGPT(RAIE74,RAIE2005) ;delete imaging pointer
- ;input RAIE74 is File 74's ien
- ;input RAIE2005 is File 2005's ien
- ; quit if either input value is 0 or null or non-numeric
- Q:'RAIE74 Q:'RAIE2005
- ; quit if report doesn't have this RAIE2005 value
- N DA,DIK
- S DA=$O(^RARPT(RAIE74,2005,"B",RAIE2005,0))
- Q:'DA
- ; delete this 2005 pointer record
- ;07/17/2008 modified setting DIK in next line
- S DA(1)=RAIE74,DIK="^RARPT("_DA(1)_",2005," D ^DIK
- Q
- EHVC ; Executable Help for File 72's VISTARAD CATEGORY field
- N RATXT,I
- F I=1:1:12 S RATXT(I)=$P($T(EHVCTXT+I),";;",2)
- D EN^DDIOL(.RATXT)
- Q
- EHVCTXT ;
- ;;This field is only needed for sites that will be using VistaRad for soft-copy
- ;;reading of images. This information is used by VistaRad software to prepare
- ;;the various types of exam lists that are displayed on the VistaRad workstation,
- ;;and to properly manage exam locking for the radiologists.
- ;;
- ;;If this Examination Status is to be used for exams that will be
- ;;read with VistaRad, then enter a value that corresponds to it
- ;;from the following list. Note that not all status codes should
- ;;be assigned a VistaRad Category value, but only those that apply.
- ;;
- ;;All other Exam Status codes that may be defined in the Radiology
- ;;Exam Status file should NOT be entered into this field.
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRARIC1 3174 printed Jan 18, 2025@03:40:11 Page 2
- RARIC1 ;HISC/GJC-Check to see if Imaging package exists ;3/4/96 15:43
- +1 ;;5.0;Radiology/Nuclear Medicine;**23,93**;Mar 16, 1998;Build 3
- +2 ; 07/15/2008 BAY/KAM rem call 249750 RA*5*93 Correct DIK Calls
- +3 ;
- +4 ; API's STUFPHY and DELIMGPT are supported by DBIA#3317
- +5 ;
- IMAGE() ; check to see if Imaging package exists
- +1 ; called from RACNLU, RAPTLU and RART1
- +2 ; 1 = exists
- +3 ; 0 = doesn't exist
- +4 SET X="MAGBAPI"
- XECUTE ^%ZOSF("TEST")
- IF '$TEST
- QUIT 0
- +5 SET X="MAGGTIA"
- XECUTE ^%ZOSF("TEST")
- IF '$TEST
- QUIT 0
- +6 QUIT $SELECT($ORDER(^MAG(2005,0)):1,1:0)
- +7 ;
- +8 ;
- STUFPHY(RAVERF,RASR,RARTN) ; stuff physician duz
- +1 ;RASR should be rtn MAGJUPD1's RIST, =15 if staff, =12 if resident
- +2 ;RAVERF=duz of physician (primary staff or primary resident)
- +3 SET RARTN="STUFPHY called"
- +4 IF '$DATA(DA(2))!'$DATA(DA(1))!'($DATA(DA)#2)
- SET RARTN="Missing DA references"
- QUIT
- +5 IF 'RASR
- SET RARTN="Missing RASR value"
- QUIT
- +6 NEW RAERR,RAFLD,RAMDIV,RAMDV,RAMLC,RAESIG,RACOD
- +7 ;
- +8 ; check loc access
- +9 SET RACOD=$SELECT(RASR=15:"S",RASR=12:"R",1:"")
- +10 IF RACOD=""
- SET RARTN="Can't determine staff/resident code"
- QUIT
- +11 IF '$$SCRN^RAUTL8(.DA,RACOD,RAVERF,"PRI")
- SET RARTN="Failed loc access"
- QUIT
- +12 ;
- +13 ; check verifier access
- +14 IF $DATA(^RADPT(DA(2),"DT",DA(1),0))
- SET RAMDIV=^(0)
- SET RAMLC=+$PIECE(RAMDIV,"^",4)
- SET RAMDIV=+$PIECE(RAMDIV,"^",3)
- SET RAMDV=$SELECT($DATA(^RA(79,RAMDIV,.1)):^(.1),1:"")
- SET RAMDV=$SELECT(RAMDV="":RAMDV,1:$TRANSLATE(RAMDV,"YyNn",1100))
- +15 IF '$DATA(RAMDV)
- SET RARTN="Can't determine RAMDV"
- QUIT
- +16 ;returns RAERR text string
- DO VERCHK^RAHLO3
- +17 IF $GET(RAERR)]""
- SET RARTN="Failed verifier: "_RAERR
- QUIT
- +18 ;
- +19 ; stuff data
- +20 SET DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"","
- +21 SET DR=RASR_"////"_RAVERF
- DO ^DIE
- KILL DI,DIC,DE,DQ,DIE,DR
- +22 SET RARTN=1
- +23 ;
- +24 ;delete 2nd staff/resident if it matches the primary staff/resident
- +25 SET RAFLD=$SELECT(RASR=15:60,RASR=12:70,1:"")
- +26 ;can't determine secondary field to check/delete
- IF 'RAFLD
- KILL DA
- QUIT
- +27 DO EN^RAUTL8(RAVERF,RAFLD,.DA)
- +28 KILL DA
- +29 QUIT
- DELIMGPT(RAIE74,RAIE2005) ;delete imaging pointer
- +1 ;input RAIE74 is File 74's ien
- +2 ;input RAIE2005 is File 2005's ien
- +3 ; quit if either input value is 0 or null or non-numeric
- +4 if 'RAIE74
- QUIT
- if 'RAIE2005
- QUIT
- +5 ; quit if report doesn't have this RAIE2005 value
- +6 NEW DA,DIK
- +7 SET DA=$ORDER(^RARPT(RAIE74,2005,"B",RAIE2005,0))
- +8 if 'DA
- QUIT
- +9 ; delete this 2005 pointer record
- +10 ;07/17/2008 modified setting DIK in next line
- +11 SET DA(1)=RAIE74
- SET DIK="^RARPT("_DA(1)_",2005,"
- DO ^DIK
- +12 QUIT
- EHVC ; Executable Help for File 72's VISTARAD CATEGORY field
- +1 NEW RATXT,I
- +2 FOR I=1:1:12
- SET RATXT(I)=$PIECE($TEXT(EHVCTXT+I),";;",2)
- +3 DO EN^DDIOL(.RATXT)
- +4 QUIT
- EHVCTXT ;
- +1 ;;This field is only needed for sites that will be using VistaRad for soft-copy
- +2 ;;reading of images. This information is used by VistaRad software to prepare
- +3 ;;the various types of exam lists that are displayed on the VistaRad workstation,
- +4 ;;and to properly manage exam locking for the radiologists.
- +5 ;;
- +6 ;;If this Examination Status is to be used for exams that will be
- +7 ;;read with VistaRad, then enter a value that corresponds to it
- +8 ;;from the following list. Note that not all status codes should
- +9 ;;be assigned a VistaRad Category value, but only those that apply.
- +10 ;;
- +11 ;;All other Exam Status codes that may be defined in the Radiology
- +12 ;;Exam Status file should NOT be entered into this field.
- +13 QUIT