| [613] | 1 | RAPSET ;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 | ;
|
|---|
| 8 | LOC 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
|
|---|
| 22 | LOC1 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 | ;
|
|---|
| 40 | PAR 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 | ;
|
|---|
| 57 | UNDEF ; 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
|
|---|
| 67 | NOESC ; 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
|
|---|
