RA119ENV ;HISC/GJC Radiation dosage report utility one ;26 Apr 2017 2:18 PM
;;5.0;Radiology/Nuclear Medicine;**119**;Mar 16, 1998;Build 7
;
EN ;entry point
;--- IAs ---
;Call/File Number Type
;------------------------------------------------
;$$PROD^XUPROD 4440 S
;$$KSP^XUPARAM 2541 S
;File #2005.632 6732 P
;File #2005.633 6733 P
;
;where 'S'=Supported; 'C'=Controlled Subscription; 'P'=Private
;
;If the site manager has designated this as the production
;account our API (#4440) will return a 1, otherwise it
;returns 0. The default check is against the PRODUCTION
;field (#501) in the KERNEL SYSTEM PARAMETERS (#8989.3) file.
;
;note: If this is a test account can exit now.
Q:$$PROD^XUPROD()=0
;
N RAI,RAS,RAX,RAY
S RAS=$$KSP^XUPARAM("WHERE"),RAY=0
;
;FNC>W !,$$KSP^XUPARAM("WHERE")
; FAYETTVL-NC.DOMAIN.EXT
;FNC>
;
;LEX>W !,$$KSP^XUPARAM("WHERE")
; LEXINGTON.DOMAIN.EXT
;LEX>
;
;STL>w !,$$KSP^XUPARAM("WHERE")
; ST-LOUIS.DOMAIN.EXT
;STL>
;
F RAI=1:1 S RAX=$P($T(SITE+RAI),";;",2,99) Q:RAX="" D Q:RAY
.S:RAS=RAX RAY=1
.Q
;
;RAY = 1: matched one of the trusted test sites
; if one of the sites quit w/o aborting install
Q:RAY
;
; if not one of the test sites there cannot be rad dose
; data in files:
; - 70.3.
; - CT DOSE #2005.632
; - PROJECTION X-RAY DOSE #2005.633
;
;RAY is still set to zero if we've gone this far.
;
I $O(^RAD(0))>0 D
.D MES^XPDUTL("Dose data was found in the RADIATION ABSORBED DOSE file.")
.S XPDQUIT=2
.Q
I $O(^MAGV(2005.632,0))>0 D
.D MES^XPDUTL("Dose data was found in the CT DOSE file.")
.S XPDQUIT=2
.Q
;
I $O(^MAGV(2005.633,0))>0 D
.D MES^XPDUTL("Dose data was found in the PROJECTION X-RAY DOSE file.")
.S XPDQUIT=2
.Q
;
D:$G(XPDQUIT)=2 BMES^XPDUTL(XPDNM_" cannot be installed.")
;
Q
;
SITE ;test sites I trust & have ready access into their production accounts
;;FAYETTVL-NC.DOMAIN.EXT
;;LEXINGTON.DOMAIN.EXT
;;ST-LOUIS.DOMAIN.EXT
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRA119ENV 2092 printed Dec 13, 2024@02:33:03 Page 2
RA119ENV ;HISC/GJC Radiation dosage report utility one ;26 Apr 2017 2:18 PM
+1 ;;5.0;Radiology/Nuclear Medicine;**119**;Mar 16, 1998;Build 7
+2 ;
EN ;entry point
+1 ;--- IAs ---
+2 ;Call/File Number Type
+3 ;------------------------------------------------
+4 ;$$PROD^XUPROD 4440 S
+5 ;$$KSP^XUPARAM 2541 S
+6 ;File #2005.632 6732 P
+7 ;File #2005.633 6733 P
+8 ;
+9 ;where 'S'=Supported; 'C'=Controlled Subscription; 'P'=Private
+10 ;
+11 ;If the site manager has designated this as the production
+12 ;account our API (#4440) will return a 1, otherwise it
+13 ;returns 0. The default check is against the PRODUCTION
+14 ;field (#501) in the KERNEL SYSTEM PARAMETERS (#8989.3) file.
+15 ;
+16 ;note: If this is a test account can exit now.
+17 if $$PROD^XUPROD()=0
QUIT
+18 ;
+19 NEW RAI,RAS,RAX,RAY
+20 SET RAS=$$KSP^XUPARAM("WHERE")
SET RAY=0
+21 ;
+22 ;FNC>W !,$$KSP^XUPARAM("WHERE")
+23 ; FAYETTVL-NC.DOMAIN.EXT
+24 ;FNC>
+25 ;
+26 ;LEX>W !,$$KSP^XUPARAM("WHERE")
+27 ; LEXINGTON.DOMAIN.EXT
+28 ;LEX>
+29 ;
+30 ;STL>w !,$$KSP^XUPARAM("WHERE")
+31 ; ST-LOUIS.DOMAIN.EXT
+32 ;STL>
+33 ;
+34 FOR RAI=1:1
SET RAX=$PIECE($TEXT(SITE+RAI),";;",2,99)
if RAX=""
QUIT
Begin DoDot:1
+35 if RAS=RAX
SET RAY=1
+36 QUIT
End DoDot:1
if RAY
QUIT
+37 ;
+38 ;RAY = 1: matched one of the trusted test sites
+39 ; if one of the sites quit w/o aborting install
+40 if RAY
QUIT
+41 ;
+42 ; if not one of the test sites there cannot be rad dose
+43 ; data in files:
+44 ; - 70.3.
+45 ; - CT DOSE #2005.632
+46 ; - PROJECTION X-RAY DOSE #2005.633
+47 ;
+48 ;RAY is still set to zero if we've gone this far.
+49 ;
+50 IF $ORDER(^RAD(0))>0
Begin DoDot:1
+51 DO MES^XPDUTL("Dose data was found in the RADIATION ABSORBED DOSE file.")
+52 SET XPDQUIT=2
+53 QUIT
End DoDot:1
+54 IF $ORDER(^MAGV(2005.632,0))>0
Begin DoDot:1
+55 DO MES^XPDUTL("Dose data was found in the CT DOSE file.")
+56 SET XPDQUIT=2
+57 QUIT
End DoDot:1
+58 ;
+59 IF $ORDER(^MAGV(2005.633,0))>0
Begin DoDot:1
+60 DO MES^XPDUTL("Dose data was found in the PROJECTION X-RAY DOSE file.")
+61 SET XPDQUIT=2
+62 QUIT
End DoDot:1
+63 ;
+64 if $GET(XPDQUIT)=2
DO BMES^XPDUTL(XPDNM_" cannot be installed.")
+65 ;
+66 QUIT
+67 ;
SITE ;test sites I trust & have ready access into their production accounts
+1 ;;FAYETTVL-NC.DOMAIN.EXT
+2 ;;LEXINGTON.DOMAIN.EXT
+3 ;;ST-LOUIS.DOMAIN.EXT
+4 ;;
