source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAPSET.m@ 1096

Last change on this file since 1096 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.6 KB
Line 
1RAPSET ;HISC/CAH,FPT,GJC AISC/MJK,RMO-Set Sign-on parameters ;5/22/97 14:22
2 ;;5.0;Radiology/Nuclear Medicine;**21**;Mar 16, 1998
3 D CHKSP^RAUTL2
4 I 'RADV!('RALC) W !!,*7,"You must initialize at least one Radiology/Nuclear Medicine Division",!,"and one Imaging Location to proceed.",!,"Refer to the Radiology/Nuclear Medicine ADPAC Guide.",!! K RADV,RALC S XQUIT="" Q
5 K RADV,RALC S (RADIV,RALOC,RADEV,DIV,LOC,DEV)="" G LOC:$D(^RA(79.2,"AC","E"))
6 D HOME^%ZIS ;I $D(IOS),IOS S DEV=$P(^%ZIS(1,+IOS,0),"^")
7 ;
8LOC I $S('($D(DUZ)#2):1,'DUZ:1,1:0) W !,*7,"Your user code 'DUZ' must be defined to continue." S XQUIT="" G Q^RAPSET1
9 S DEV="" W:$D(^RA(79.2,"AC","E")) ?15,"**** Normal Computer is Down. ****",!
10 I $G(DIC("B"))="",$D(^DISV(+DUZ,"^RA(79.1,")),$D(^RA(79.1,+^DISV(+DUZ,"^RA(79.1,"),0)) S DIC("B")=$S($D(^RA(79.1,+^DISV(+DUZ,"^RA(79.1,"),0)):$S($D(^SC(+^(0),0)):$P(^(0),"^"),1:""),1:"") I DIC("B")']"" K DIC("B")
11 I $D(DIC("B")),$P($G(^RA(79.1,+^DISV(+DUZ,"^RA(79.1,"),0)),U,19) K DIC("B")
12 ; display default img loc ONLY IF it matches proc's img loc's img type
13 ; SETDISV^RAREG3 already took care of settg default DIC("B") if lone img type
14 G:'$G(RAITN) LOC1
15 N RA1,RA2,RA3
16 G:$G(DIC("B"))="" LOC1
17 S RA1=0,RA2=0 ; RA1 = name of loc RA2 = ien of img loc
18 F S RA1=$O(^SC("B",DIC("B"),RA1)) Q:'RA1 S:'RA2 RA2=$O(^RA(79.1,"B",RA1,0)) ; use 1st non-null RA2
19 S RA3=$P(^RA(79.1,RA2,0),"^",6) ;ien img type
20 I RA3'=RAITN K DIC("B")
21 I $P(^RA(79.1,RA2,0),"^",19) K DIC("B") ;Don't show inactive loc as dflt
22LOC1 D:'$D(RACCESS(DUZ)) VARACC^RAUTL6(DUZ) ; Setup user's access
23 S DIC("A")="Please select a sign-on Imaging Location: "
24 S DIC("S")="I $D(RACCESS(DUZ,""LOC"",+Y))"
25 I $D(RAOPT("REG"))#2!('$D(^XUSEC("RA ALLOC",DUZ))) D
26 .S DIC("S")=DIC("S")_"&($P(^RA(79.1,+Y,0),U,19)']"""")"
27 I $D(RADUPSCN),($D(RAREGX(4))),($D(RAYN)) D
28 . S DIC("B")=$P($G(^SC(+$G(^RA(79.1,RAREGX(4),0)),0)),U)
29 . N X S X=$P($G(^RA(79.1,RAREGX(4),0)),U,19) I X,X'>DT K DIC("B")
30 . S DIC("S")=DIC("S")_"&(+Y=RAREGX(4))" ; RA FLASH (DUP^RAEDCN)
31 . Q
32 S DIC="^RA(79.1,",DIC(0)="AEMQ" D ^DIC
33 K DIC("A"),DIC("S") I $D(DTOUT)!($D(DUOUT)) S XQUIT="" G Q^RAPSET1
34 I Y<0 W !?3,*7,"You must choose an Imaging 'Location' to continue...",!?3,"or enter '^' to stop.",! G LOC1
35 S LOC=+Y,DIV=$O(^RA(79,"AL",LOC,0))
36 I DIV'>0!('$D(^RA(79,+DIV,0))) W !,*7,"Radiology/Nuclear Medicine Division definition error. Call your site manager." S XQUIT="" G Q^RAPSET1
37 S RADIV=^RA(79,DIV,0),RALOC=$S($D(^RA(79.1,LOC,0)):^(0),1:"")
38 I RALOC']"" W !!,*7,"Imaging Location definition error. Call your site manager." S XQUIT="" G Q^RAPSET1
39 ;
40PAR S RAMDIV=DIV,Y=$S($D(^RA(79,DIV,.1)):^(.1),1:""),RAMDV="" F I=1:1 Q:$P(Y,"^",I,99)']"" S RAMDV=RAMDV_$S($P(Y,"^",I)="Y"!($P(Y,"^",I)="y"):1,1:0)_"^"
41 I $P(RAMDV,"^",6),DEV,$P(RADEV,"^")["Y" S $P(RAMDV,"^",6)=0
42 ;
43 S RAMLC=LOC_"^"_$S('$P(RAMDV,"^",2):+$P(RALOC,"^",2),1:0)
44 S RAI=$S($P(RALOC,"^",3)']"":-1,1:+$P(RALOC,"^",3)),RAFLH=$S($D(^%ZIS(1,+RAI,0)):$P(^(0),"^"),1:"")
45 I RAFLH']""!($D(^RA(79.2,"AC","E"))) S %ZIS="N",%ZIS("A")="Default Flash Card Printer: " D ^%ZIS D:POP NOESC S RAFLH=$S(POP:"",IO=IO(0):"",1:ION),RAI=$S(RAFLH="":"",1:$O(^%ZIS(1,"B",RAFLH,0)))
46 S RAMLC=RAMLC_"^"_RAFLH_"^"_$S($P(RAMDV,"^",8):$S($P(RALOC,"^",4):$P(RALOC,"^",4),1:2),1:0),RAFLH=$S(RAFLH']"":0,RAI>0:RAI,1:0)
47 S RAI=$S($P(RALOC,"^",5)']"":-1,1:+$P(RALOC,"^",5)),RAJAC=$S($D(^%ZIS(1,+RAI,0)):$P(^(0),"^"),1:"")
48 I RAJAC']""!($D(^RA(79.2,"AC","E"))) S %ZIS="N",%ZIS("A")="Default Jacket Label Printer: " D ^%ZIS D:POP NOESC S RAJAC=$S(POP:"",IO=IO(0):"",1:ION),RAI=$S(RAJAC="":"",1:$O(^%ZIS(1,"B",RAJAC,0)))
49 S RAMLC=RAMLC_"^"_RAJAC_"^"_$P(RALOC,"^",6,9),RAJAC=$S(RAJAC']"":0,RAI>0:RAI,1:0)
50 S RAI=$S($P(RALOC,"^",10)']"":-1,1:+$P(RALOC,"^",10)),RARPT=$S($D(^%ZIS(1,+RAI,0)):$P(^(0),"^"),1:"")
51 I RARPT']""!($D(^RA(79.2,"AC","E"))) S %ZIS="N",%ZIS("A")="Default Report Printer: " D ^%ZIS D:POP NOESC S RARPT=$S(POP:"",IO=IO(0):"",1:ION),RAI=$S(RARPT="":"",1:$O(^%ZIS(1,"B",RARPT,0)))
52 S RAMLC=RAMLC_"^"_RARPT_"^"_$P(RALOC,"^",11,13),RARPT=$S(RARPT']"":0,RAI>0:RAI,1:0) S LINE="",$P(LINE,"-",80)=""
53 S RAIMGTY=$$IMGTY^RAUTL12("l",+RAMLC)
54 I RAIMGTY']"" D UNDEF,KILL^RAPSET1 Q
55 D HOME^%ZIS G ^RAPSET1
56 ;
57UNDEF ; Message for undefined imaging types
58 N RAVAPOR
59 I '+$G(RAMLC) D Q
60 . W !?5,"Imaging Location data is not defined, "
61 . W "contact IRM.",$C(7)
62 . Q
63 S RAVAPOR=$P($G(^SC(+$P($G(^RA(79.1,+RAMLC,0)),U),0)),U)
64 W !?5,"An Imaging Type was not defined for the following Imaging"
65 W !?5,"Location: '"_$S(RAVAPOR']"":"Unknown",1:RAVAPOR)_"'"
66 Q
67NOESC ; No up-arrow allowed at Flash Card, Jacket Label, or Report
68 ; printer device prompts after selecting sign-on imaging location.
69 W $C(7),!,"No up-arrow allowed. Default printer will be your terminal."
70 Q
Note: See TracBrowser for help on using the repository browser.