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