source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAPSET1.m@ 1005

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

initial load of WorldVistAEHR
File size: 3.5 KB
RevLine 
[613]1RAPSET1 ;HISC/FPT,GJC AISC/MJK-Set Sign-on parameters ;5/22/97 14:22
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3DIS W !!,LINE,!,"Welcome, you are signed on with the following parameters:"
4 W !!?35,"Printer Defaults",!?1,"Version : ",$G(^DD(70,0,"VR")),?35,"----------------",!?1,"Division : ",$E($S($D(^DIC(4,+RAMDIV,0)):$P(^(0),"^"),1:"Unknown"),1,20)
5 W ?35,"Flash Card : " W:RAFLH $E($P(RAMLC,"^",3)_" "_$S($D(^%ZIS(1,+RAFLH,1)):$P(^(1),"^"),1:""),1,30) W:'RAFLH "None"
6 W !?1,"Location : ",$E($S('$D(^RA(79.1,+RAMLC,0)):"Unknown",$D(^SC(+^(0),0)):$P(^(0),"^"),1:"Unknown"),1,20),?49,$S($P(RAMLC,"^",2):$P(RAMLC,"^",2)_" card/visit",$P(RAMDV,"^",2):"1 card/exam",1:"No cards")
7 W !?1,"Img. Type: ",$S($D(^RA(79.2,+$P(RAMLC,"^",6),0)):$E($P(^(0),"^"),1,20),1:"Unknown"),?35,"Jacket Label: " W:RAJAC $E($P(RAMLC,"^",5)_" "_$S($D(^%ZIS(1,+RAJAC,1)):$P(^(1),"^"),1:""),1,30) W:'RAJAC "None"
8 W !?1,"User : ",$S($D(^VA(200,+DUZ,0)):$P(^(0),"^"),1:"Unknown"),?49,$S($P(RAMLC,"^",4):$P(RAMLC,"^",4)_" labels/visit",1:"")
9 W ! I $P($G(^RA(79.1,+$P(RAMLC,"^"),0)),"^",19) W ?1,"** INACTIVE LOCATION **"
10 W ?35,"Report : " W:RARPT $E($P(RAMLC,"^",10)_" "_$S($D(^%ZIS(1,+RARPT,1)):$P(^(1),"^"),1:""),1,30) W:'RARPT "None"
11 I $P($G(^RA(79.2,+$P(RAMLC,"^",6),0)),"^",5)="Y" D
12 . N RADOSE,RADSE
13 . W !?35,"Dosage : " W:$P(RALOC,"^",23)']"" "None"
14 . I $P(RALOC,"^",23) D
15 .. D GETS^DIQ(3.5,$P(RALOC,"^",23)_",",".01;.02","","RADOSE")
16 .. S RADSE=RADOSE(3.5,$P(RALOC,"^",23)_",",.01)_" "_RADOSE(3.5,$P(RALOC,"^",23)_",",.02)
17 .. W $E(RADSE,1,30)
18 . Q
19 W !,LINE
20 ;
21Q ; Kill and quit
22 I $D(RASWLOC),($D(XQUIT)),(XQUIT']"") K XQUIT ; RA LOC SWITCH option
23 K %ZIS,RAI,DEV,DEVI,DIC,DIV,DUOUT,I,LINE,LOC,RADEV,RADIV,RAFLH
24 K RAJAC,RALOC,RARPT,X,Y,POP,DISYS
25 Q
26 ;
27SET K RALONE G ^RAPSET:'$D(RAMDIV)!('$D(RAMDV))!('$D(RAMLC))!('$D(RAIMGTY)) Q
28 ;
29KILL K RACCESS,RAMDIV,RAMDV,RAIMGTY,RAMLC
30 Q
31SETVARS(X) ; Set variables integral to package operation.
32 ; This code is used in lieu of the Entry Actions for many of the
33 ; Radiology/Nuclear Medicine options.
34 ; Problems Resolved: '^' jump, independently invoking options
35 ; 'X=0' ---> Silent, creates RACCESS array.
36 ; 'X=1' ---> Interactive, calls ^RAPSET (prompts for sign-on location)
37 D @$S(X=1:"^RAPSET",1:"VARACC^RAUTL6(DUZ)") K %,%W,%Y,%Y1,C,POP
38 Q
39SW(RAXAMI,RALOGI) ; During 'Case No. Exam Edit' the user picked an exam
40 ; that has a different imaging type than the imaging type of our
41 ; sign-on location. This subroutine askes the user if they want to
42 ; switch locations. RAMASK set in CHECK^RACNLU (saves off 'Y'
43 ; 0 node of exam)
44 ; Input Variables: RAXAMI-> imaging type of the exam
45 ; RALOGI-> sign-on location imaging type
46 ;
47 ; Output Variable: 1 if location switch invalid, 0 if valid switch.
48 S:RAXAMI="" RAXAMI="UNKNOWN" S:RALOGI="" RALOGI="UNKNOWN"
49 W !!?7,"Current Imaging Type: ",RALOGI,!?5,"Procedure Imaging Type: ",RAXAMI
50 W !!,"You must switch to a location of ",RAXAMI," imaging type."
51 N RA7002 S RA7002=$G(^RADPT(+$P(RAMASK,"^"),"DT",+$P(RAMASK,"^",2),0))
52 S:$D(RACCESS(DUZ,"LOC",+$P(RA7002,"^",4))) ^DISV(DUZ,"^RA(79.1,")=+$P(RA7002,"^",4)
53 I '$D(RACCESS(DUZ,"LOC",+$G(^DISV(DUZ,"^RA(79.1,")))) D
54 . N I S I=0 F S I=$O(RACCESS(DUZ,"LOC",I)) Q:I'>0 D
55 .. S:$D(^RA(79.1,"BIMG",+$P(RA7002,"^",2),I)) ^DISV(DUZ,"^RA(79.1,")=I
56 .. Q
57 . Q
58 Q:'$D(^RA(79.1,"BIMG",+$P(RA7002,"^",2),+$G(^DISV(DUZ,"^RA(79.1,")))) "1^Sorry, you don't have access privileges to edit cases of this imaging type."
59 K RAMLC S RASWLOC="" D SET^RAPSET1 K RASWLOC
60 Q $S($$GET1^DIQ(79.1,+$G(RAMLC)_",",6,"E")'=RAXAMI:"1^No matches for this sign-on location!",1:0)
Note: See TracBrowser for help on using the repository browser.