Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAPSET1

RAPSET1.m

Go to the documentation of this file.
  1. RAPSET1 ;HISC/FPT,GJC AISC/MJK-Set Sign-on parameters ;5/22/97 14:22
  1. ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
  1. DIS W !!,LINE,!,"Welcome, you are signed on with the following parameters:"
  1. 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)
  1. W ?35,"Flash Card : " W:RAFLH $E($P(RAMLC,"^",3)_" "_$S($D(^%ZIS(1,+RAFLH,1)):$P(^(1),"^"),1:""),1,30) W:'RAFLH "None"
  1. 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")
  1. 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"
  1. W !?1,"User : ",$S($D(^VA(200,+DUZ,0)):$P(^(0),"^"),1:"Unknown"),?49,$S($P(RAMLC,"^",4):$P(RAMLC,"^",4)_" labels/visit",1:"")
  1. W ! I $P($G(^RA(79.1,+$P(RAMLC,"^"),0)),"^",19) W ?1,"** INACTIVE LOCATION **"
  1. W ?35,"Report : " W:RARPT $E($P(RAMLC,"^",10)_" "_$S($D(^%ZIS(1,+RARPT,1)):$P(^(1),"^"),1:""),1,30) W:'RARPT "None"
  1. I $P($G(^RA(79.2,+$P(RAMLC,"^",6),0)),"^",5)="Y" D
  1. . N RADOSE,RADSE
  1. . W !?35,"Dosage : " W:$P(RALOC,"^",23)']"" "None"
  1. . I $P(RALOC,"^",23) D
  1. .. D GETS^DIQ(3.5,$P(RALOC,"^",23)_",",".01;.02","","RADOSE")
  1. .. S RADSE=RADOSE(3.5,$P(RALOC,"^",23)_",",.01)_" "_RADOSE(3.5,$P(RALOC,"^",23)_",",.02)
  1. .. W $E(RADSE,1,30)
  1. . Q
  1. W !,LINE
  1. ;
  1. Q ; Kill and quit
  1. I $D(RASWLOC),($D(XQUIT)),(XQUIT']"") K XQUIT ; RA LOC SWITCH option
  1. K %ZIS,RAI,DEV,DEVI,DIC,DIV,DUOUT,I,LINE,LOC,RADEV,RADIV,RAFLH
  1. K RAJAC,RALOC,RARPT,X,Y,POP,DISYS
  1. Q
  1. ;
  1. SET K RALONE G ^RAPSET:'$D(RAMDIV)!('$D(RAMDV))!('$D(RAMLC))!('$D(RAIMGTY)) Q
  1. ;
  1. KILL K RACCESS,RAMDIV,RAMDV,RAIMGTY,RAMLC
  1. Q
  1. SETVARS(X) ; Set variables integral to package operation.
  1. ; This code is used in lieu of the Entry Actions for many of the
  1. ; Radiology/Nuclear Medicine options.
  1. ; Problems Resolved: '^' jump, independently invoking options
  1. ; 'X=0' ---> Silent, creates RACCESS array.
  1. ; 'X=1' ---> Interactive, calls ^RAPSET (prompts for sign-on location)
  1. D @$S(X=1:"^RAPSET",1:"VARACC^RAUTL6(DUZ)") K %,%W,%Y,%Y1,C,POP
  1. Q
  1. SW(RAXAMI,RALOGI) ; During 'Case No. Exam Edit' the user picked an exam
  1. ; that has a different imaging type than the imaging type of our
  1. ; sign-on location. This subroutine askes the user if they want to
  1. ; switch locations. RAMASK set in CHECK^RACNLU (saves off 'Y'
  1. ; 0 node of exam)
  1. ; Input Variables: RAXAMI-> imaging type of the exam
  1. ; RALOGI-> sign-on location imaging type
  1. ;
  1. ; Output Variable: 1 if location switch invalid, 0 if valid switch.
  1. S:RAXAMI="" RAXAMI="UNKNOWN" S:RALOGI="" RALOGI="UNKNOWN"
  1. W !!?7,"Current Imaging Type: ",RALOGI,!?5,"Procedure Imaging Type: ",RAXAMI
  1. W !!,"You must switch to a location of ",RAXAMI," imaging type."
  1. N RA7002 S RA7002=$G(^RADPT(+$P(RAMASK,"^"),"DT",+$P(RAMASK,"^",2),0))
  1. S:$D(RACCESS(DUZ,"LOC",+$P(RA7002,"^",4))) ^DISV(DUZ,"^RA(79.1,")=+$P(RA7002,"^",4)
  1. I '$D(RACCESS(DUZ,"LOC",+$G(^DISV(DUZ,"^RA(79.1,")))) D
  1. . N I S I=0 F S I=$O(RACCESS(DUZ,"LOC",I)) Q:I'>0 D
  1. .. S:$D(^RA(79.1,"BIMG",+$P(RA7002,"^",2),I)) ^DISV(DUZ,"^RA(79.1,")=I
  1. .. Q
  1. . Q
  1. 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."
  1. K RAMLC S RASWLOC="" D SET^RAPSET1 K RASWLOC
  1. Q $S($$GET1^DIQ(79.1,+$G(RAMLC)_",",6,"E")'=RAXAMI:"1^No matches for this sign-on location!",1:0)