source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RANMUTL1.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1RANMUTL1 ;HISC/SWM-Nuclear Medicine utilites ;8/6/97 08:48
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3SELIMG ; Select Imaging Type, if exists; code is from RAUTL7
4 ; Prompts user to select Imaging Type(s).
5 ; Creates ^TMP($J,"RA I-TYPE",Imaging Type name,Imaging Type IEN)=""
6 N RA,RAIMGNUM,RAONE S RA="",RAONE=$$IMG1^RAUTL7()
7 ; .... chk if only 1 img type is available
8 I $P(RAONE,"^")]"",('$D(^TMP($J,"RA D-TYPE"))) S RAQUIT=0 D Q
9 . S ^TMP($J,"RA I-TYPE",$P(RAONE,"^"),$P(RAONE,"^",2))=""
10 . Q
11 ; .... chk if only 1 img type within selectable division is available
12 ; raimgnum = number of selectable img types
13 I $D(^TMP($J,"RA D-TYPE")) D
14 . D SETUP1 S RAIMGNUM=$$IMGNUM^RAUTL7A()
15 . Q
16 I $D(^TMP($J,"RA D-TYPE")),(RAIMGNUM=1) D S RAQUIT=0 Q
17 . N RA0,RA1
18 . S RA1=+$O(^TMP($J,"DIV-IMG",0)),RA0=$P($G(^RA(79.2,RA1,0)),"^")
19 . S ^TMP($J,"RA I-TYPE",RA0,RA1)=""
20 . Q
21 S RADIC="^RA(79.2,",RADIC(0)="QEAMZ",RAUTIL="RA I-TYPE"
22 S RADIC("A")="Select Imaging Type: ",RADIC("B")="All"
23 I $D(^TMP($J,"RA D-TYPE")) D
24 . S RADIC("S")="I $D(^TMP($J,""DIV-IMG"",+Y)),($D(RACCESS(DUZ,""IMG"",+Y)))"
25 . Q
26 ; why do we need to check the alternative ? DIVLOC+3 prevents this
27 ; alternative from occurring.
28 E S RADIC("S")="I $D(RACCESS(DUZ,""IMG"",+Y))"
29 W !! D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,RADIC,RAUTIL,X,Y
30 Q
31SELRADIO ; Setup ^TMP($J,"RA EITHER",ien file 50)
32 S RAINPUT=""
33 K DIR,X,Y S DIR(0)="YA",DIR("B")="Yes"
34 S DIR("A")="Do you wish to include all Radiopharms ? "
35 S DIR("?",1)="Enter 'Yes' to select all Radiopharms."
36 S DIR("?")="Enter 'No' to select a subset of Radiopharms."
37 W ! D ^DIR K DIR Q:$D(DIRUT)
38 S RAINPUT=+Y K DIROUT,DIRUT,DTOUT,DUOUT,X,Y
39 Q:RAINPUT
40 S RADIC="^PSDRUG(",RADIC(0)="QEAMZ",RAUTIL="RA EITHER"
41 S RADIC("A")="Select Radiopharm: "
42 S RADIC("S")="I $$DCHK^RADD1(""R"",0,+Y)" ; dt=0, only radiopharms
43 W !! D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,RADIC,RAUTIL,X,Y
44 Q
45SELADMIN ; Setup ^TMP($J,"RA EITHER",ien file 50)
46 S RAINPUT=""
47 K DIR,X,Y S DIR(0)="YA",DIR("B")="Yes"
48 S DIR("A")="Do you wish to include all who administered dose ? "
49 S DIR("?",1)="Enter 'Yes' to select all who administered dose."
50 S DIR("?")="Enter 'No' to select some who administered dose."
51 W ! D ^DIR K DIR Q:$D(DIRUT)
52 S RAINPUT=+Y K DIROUT,DIRUT,DTOUT,DUOUT,X,Y
53 Q:RAINPUT
54 S RADIC="^VA(200,",RADIC(0)="QEAMZ",RAUTIL="RA EITHER"
55 S RADIC("A")="Select Person Who Admin Dose: "
56 ; passed parameters to circumvent person's inactive date
57 ; only the 4th param, 0, is really used to choose staff/resid/tech
58 S RADIC("S")="I $$VALADM^RADD1(1,+Y,1,0)" ;
59 W !! D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,RADIC,RAUTIL,X,Y
60 Q
61SELDATES ; Define RADTBEG and RADTEND
62 S RAPOP=0 W !!,"**** Date Range Selection ****"
63 W ! S %DT="APEXT"
64 S %DT("A")=" Beginning DATE : "
65 S %DT("B")="T-1"
66 D ^%DT S:Y<0 RAPOP=1 Q:Y<0 S (%DT(0),RADTBEG)=Y
67 W ! S %DT="APEXT"
68 S %DT("A")=" Ending DATE : "
69 S %DT("B")="T-1@24:00"
70 D ^%DT K %DT S:Y<0 RAPOP=1 Q:Y<0 S RADTEND=Y
71 S RADTBEG("X")=$$FMTE^XLFDT(RADTBEG,1) ; for display in header
72 S RADTEND("X")=$$FMTE^XLFDT(RADTEND,1)
73 S:$P(RADTEND,".",2)="" RADTEND=RADTEND_".9999"
74 Q
75SELSORT ; select sort order
76 W ! S RAPOP=0,RASORT=0
77 S DIR("A")="Sort Exam Date/Time before "_$S(RATITLE["Usage":"Radiopharm",1:"Who Admin Dose")_" ? : "
78 S DIR(0)="YAO",DIR("B")="NO" D ^DIR
79 I $D(DIRUT)!($D(DUOUT)) S RAPOP=1 Q
80 S RASORT=Y ; 1=YES, 0=NO
81 Q
82SETUP1 ; Setup ^TMP($J,"DIV-IMG",Imaging Type IEN)=""
83 ; based upon ^TMP($J,"RA D-TYPE",Division name)
84 ; RACCESS "DIV-IMG"
85 ; elements.
86 N RAX,RAY,RAZ S RAX=""
87 F S RAX=$O(^TMP($J,"RA D-TYPE",RAX)) Q:RAX']"" D
88 . I $D(RACCESS(DUZ,"DIV-IMG",RAX)) D
89 .. S RAY="" F S RAY=$O(RACCESS(DUZ,"DIV-IMG",RAX,RAY)) Q:RAY']"" D
90 ... Q:$P($G(^RA(79.2,+$O(^RA(79.2,"B",RAY,0)),0)),U,5)'="Y" ;file 79.2's RADIOPHARM..USED
91 ... S RAZ=+$O(^RA(79.2,"B",RAY,0)),^TMP($J,"DIV-IMG",RAZ)=""
92 ... Q
93 .. Q
94 . Q
95 Q
Note: See TracBrowser for help on using the repository browser.