| 1 | RARIC1 ;HISC/GJC-Check to see if Imaging package exists ;3/4/96 15:43
|
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;**23**;Mar 16, 1998
|
|---|
| 3 | ;
|
|---|
| 4 | ; API's STUFPHY and DELIMGPT are supported by DBIA#3317
|
|---|
| 5 | ;
|
|---|
| 6 | IMAGE() ; check to see if Imaging package exists
|
|---|
| 7 | ; called from RACNLU, RAPTLU and RART1
|
|---|
| 8 | ; 1 = exists
|
|---|
| 9 | ; 0 = doesn't exist
|
|---|
| 10 | S X="MAGBAPI" X ^%ZOSF("TEST") I '$T Q 0
|
|---|
| 11 | S X="MAGGTIA" X ^%ZOSF("TEST") I '$T Q 0
|
|---|
| 12 | Q $S($O(^MAG(2005,0)):1,1:0)
|
|---|
| 13 | ;
|
|---|
| 14 | ;
|
|---|
| 15 | STUFPHY(RAVERF,RASR,RARTN) ; stuff physician duz
|
|---|
| 16 | ;RASR should be rtn MAGJUPD1's RIST, =15 if staff, =12 if resident
|
|---|
| 17 | ;RAVERF=duz of physician (primary staff or primary resident)
|
|---|
| 18 | S RARTN="STUFPHY called"
|
|---|
| 19 | I '$D(DA(2))!'$D(DA(1))!'($D(DA)#2) S RARTN="Missing DA references" Q
|
|---|
| 20 | I 'RASR S RARTN="Missing RASR value" Q
|
|---|
| 21 | N RAERR,RAFLD,RAMDIV,RAMDV,RAMLC,RAESIG,RACOD
|
|---|
| 22 | ;
|
|---|
| 23 | ; check loc access
|
|---|
| 24 | S RACOD=$S(RASR=15:"S",RASR=12:"R",1:"")
|
|---|
| 25 | I RACOD="" S RARTN="Can't determine staff/resident code" Q
|
|---|
| 26 | I '$$SCRN^RAUTL8(.DA,RACOD,RAVERF,"PRI") S RARTN="Failed loc access" Q
|
|---|
| 27 | ;
|
|---|
| 28 | ; check verifier access
|
|---|
| 29 | 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))
|
|---|
| 30 | I '$D(RAMDV) S RARTN="Can't determine RAMDV" Q
|
|---|
| 31 | D VERCHK^RAHLO3 ;returns RAERR text string
|
|---|
| 32 | I $G(RAERR)]"" S RARTN="Failed verifier: "_RAERR Q
|
|---|
| 33 | ;
|
|---|
| 34 | ; stuff data
|
|---|
| 35 | S DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"","
|
|---|
| 36 | S DR=RASR_"////"_RAVERF D ^DIE K DI,DIC,DE,DQ,DIE,DR
|
|---|
| 37 | S RARTN=1
|
|---|
| 38 | ;
|
|---|
| 39 | ;delete 2nd staff/resident if it matches the primary staff/resident
|
|---|
| 40 | S RAFLD=$S(RASR=15:60,RASR=12:70,1:"")
|
|---|
| 41 | I 'RAFLD K DA Q ;can't determine secondary field to check/delete
|
|---|
| 42 | D EN^RAUTL8(RAVERF,RAFLD,.DA)
|
|---|
| 43 | K DA
|
|---|
| 44 | Q
|
|---|
| 45 | DELIMGPT(RAIE74,RAIE2005) ;delete imaging pointer
|
|---|
| 46 | ;input RAIE74 is File 74's ien
|
|---|
| 47 | ;input RAIE2005 is File 2005's ien
|
|---|
| 48 | ; quit if either input value is 0 or null or non-numeric
|
|---|
| 49 | Q:'RAIE74 Q:'RAIE2005
|
|---|
| 50 | ; quit if report doesn't have this RAIE2005 value
|
|---|
| 51 | N DA,DIK
|
|---|
| 52 | S DA=$O(^RARPT(RAIE74,2005,"B",RAIE2005,0))
|
|---|
| 53 | Q:'DA
|
|---|
| 54 | ; delete this 2005 pointer record
|
|---|
| 55 | S DA(1)=RAIE74,DIK="^RARPT(DA(1),2005," D ^DIK
|
|---|
| 56 | Q
|
|---|
| 57 | EHVC ; Executable Help for File 72's VISTARAD CATEGORY field
|
|---|
| 58 | N RATXT,I
|
|---|
| 59 | F I=1:1:12 S RATXT(I)=$P($T(EHVCTXT+I),";;",2)
|
|---|
| 60 | D EN^DDIOL(.RATXT)
|
|---|
| 61 | Q
|
|---|
| 62 | EHVCTXT ;
|
|---|
| 63 | ;;This field is only needed for sites that will be using VistaRad for soft-copy
|
|---|
| 64 | ;;reading of images. This information is used by VistaRad software to prepare
|
|---|
| 65 | ;;the various types of exam lists that are displayed on the VistaRad workstation,
|
|---|
| 66 | ;;and to properly manage exam locking for the radiologists.
|
|---|
| 67 | ;;
|
|---|
| 68 | ;;If this Examination Status is to be used for exams that will be
|
|---|
| 69 | ;;read with VistaRad, then enter a value that corresponds to it
|
|---|
| 70 | ;;from the following list. Note that not all status codes should
|
|---|
| 71 | ;;be assigned a VistaRad Category value, but only those that apply.
|
|---|
| 72 | ;;
|
|---|
| 73 | ;;All other Exam Status codes that may be defined in the Radiology
|
|---|
| 74 | ;;Exam Status file should NOT be entered into this field.
|
|---|
| 75 | Q
|
|---|
