RANMUTL1 ;HISC/SWM-Nuclear Medicine utilites ;8/6/97 08:48
;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8
;
;Supported IA #10103 reference to FMTE^XLFDT
;
SELIMG ; Select Imaging Type, if exists; code is from RAUTL7
; Prompts user to select Imaging Type(s).
; Creates ^TMP($J,"RA I-TYPE",Imaging Type name,Imaging Type IEN)=""
N RA,RAIMGNUM,RAONE S RA="",RAONE=$$IMG1^RAUTL7()
; .... chk if only 1 img type is available
I $P(RAONE,"^")]"",('$D(^TMP($J,"RA D-TYPE"))) S RAQUIT=0 D Q
. S ^TMP($J,"RA I-TYPE",$P(RAONE,"^"),$P(RAONE,"^",2))=""
. Q
; .... chk if only 1 img type within selectable division is available
; raimgnum = number of selectable img types
I $D(^TMP($J,"RA D-TYPE")) D
. D SETUP1 S RAIMGNUM=$$IMGNUM^RAUTL7A()
. Q
I $D(^TMP($J,"RA D-TYPE")),(RAIMGNUM=1) D S RAQUIT=0 Q
. N RA0,RA1
. S RA1=+$O(^TMP($J,"DIV-IMG",0)),RA0=$P($G(^RA(79.2,RA1,0)),"^")
. S ^TMP($J,"RA I-TYPE",RA0,RA1)=""
. Q
S RADIC="^RA(79.2,",RADIC(0)="QEAMZ",RAUTIL="RA I-TYPE"
S RADIC("A")="Select Imaging Type: ",RADIC("B")="All"
I $D(^TMP($J,"RA D-TYPE")) D
. S RADIC("S")="I $D(^TMP($J,""DIV-IMG"",+Y)),($D(RACCESS(DUZ,""IMG"",+Y)))"
. Q
; why do we need to check the alternative ? DIVLOC+3 prevents this
; alternative from occurring.
E S RADIC("S")="I $D(RACCESS(DUZ,""IMG"",+Y))"
W !! D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,RADIC,RAUTIL,X,Y
Q
SELRADIO ; Setup ^TMP($J,"RA EITHER",ien file 50)
S RAINPUT=""
K DIR,X,Y S DIR(0)="YA",DIR("B")="Yes"
S DIR("A")="Do you wish to include all Radiopharms ? "
S DIR("?",1)="Enter 'Yes' to select all Radiopharms."
S DIR("?")="Enter 'No' to select a subset of Radiopharms."
W ! D ^DIR K DIR Q:$D(DIRUT)
S RAINPUT=+Y K DIROUT,DIRUT,DTOUT,DUOUT,X,Y
Q:RAINPUT
S RADIC="^PSDRUG(",RADIC(0)="QEAMZ"
S RADIC("A")="Select Radiopharm: "
W !! D EN2^RAPSAPI(.RADIC,"RA EITHER") K %W,%Y1,DIC,RADIC,RAUTIL,X,Y
Q
SELADMIN ; Setup ^TMP($J,"RA EITHER",ien file 50)
S RAINPUT=""
K DIR,X,Y S DIR(0)="YA",DIR("B")="Yes"
S DIR("A")="Do you wish to include all who administered dose ? "
S DIR("?",1)="Enter 'Yes' to select all who administered dose."
S DIR("?")="Enter 'No' to select some who administered dose."
W ! D ^DIR K DIR Q:$D(DIRUT)
S RAINPUT=+Y K DIROUT,DIRUT,DTOUT,DUOUT,X,Y
Q:RAINPUT
S RADIC="^VA(200,",RADIC(0)="QEAMZ",RAUTIL="RA EITHER"
S RADIC("A")="Select Person Who Admin Dose: "
; passed parameters to circumvent person's inactive date
; only the 4th param, 0, is really used to choose staff/resid/tech
S RADIC("S")="I $$VALADM^RADD1(1,+Y,1,0)" ;
W !! D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,RADIC,RAUTIL,X,Y
Q
SELDATES ; Define RADTBEG and RADTEND
S RAPOP=0 W !!,"**** Date Range Selection ****"
W ! S %DT="APEXT"
S %DT("A")=" Beginning DATE : "
S %DT("B")="T-1"
D ^%DT S:Y<0 RAPOP=1 Q:Y<0 S (%DT(0),RADTBEG)=Y
W ! S %DT="APEXT"
S %DT("A")=" Ending DATE : "
S %DT("B")="T-1@24:00"
D ^%DT K %DT S:Y<0 RAPOP=1 Q:Y<0 S RADTEND=Y
S RADTBEG("X")=$$FMTE^XLFDT(RADTBEG,1) ; for display in header
S RADTEND("X")=$$FMTE^XLFDT(RADTEND,1)
S:$P(RADTEND,".",2)="" RADTEND=RADTEND_".9999"
Q
SELSORT ; select sort order
W ! S RAPOP=0,RASORT=0
S DIR("A")="Sort Exam Date/Time before "_$S(RATITLE["Usage":"Radiopharm",1:"Who Admin Dose")_" ? : "
S DIR(0)="YAO",DIR("B")="NO" D ^DIR
I $D(DIRUT)!($D(DUOUT)) S RAPOP=1 Q
S RASORT=Y ; 1=YES, 0=NO
Q
SETUP1 ; Setup ^TMP($J,"DIV-IMG",Imaging Type IEN)=""
; based upon ^TMP($J,"RA D-TYPE",Division name)
; RACCESS "DIV-IMG"
; elements.
N RAX,RAY,RAZ S RAX=""
F S RAX=$O(^TMP($J,"RA D-TYPE",RAX)) Q:RAX']"" D
. I $D(RACCESS(DUZ,"DIV-IMG",RAX)) D
.. S RAY="" F S RAY=$O(RACCESS(DUZ,"DIV-IMG",RAX,RAY)) Q:RAY']"" D
... Q:$P($G(^RA(79.2,+$O(^RA(79.2,"B",RAY,0)),0)),U,5)'="Y" ;file 79.2's RADIOPHARM..USED
... S RAZ=+$O(^RA(79.2,"B",RAY,0)),^TMP($J,"DIV-IMG",RAZ)=""
... Q
.. Q
. Q
Q
RANMUTL1 ;HISC/SWM-Nuclear Medicine utilites ;8/6/97 08:48
+1 ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8
+2 ;
+3 ;Supported IA #10103 reference to FMTE^XLFDT
+4 ;
SELIMG ; Select Imaging Type, if exists; code is from RAUTL7
+1 ; Prompts user to select Imaging Type(s).
+2 ; Creates ^TMP($J,"RA I-TYPE",Imaging Type name,Imaging Type IEN)=""
+3 NEW RA,RAIMGNUM,RAONE
SET RA=""
SET RAONE=$$IMG1^RAUTL7()
+4 ; .... chk if only 1 img type is available
+5 IF $PIECE(RAONE,"^")]""
IF ('$DATA(^TMP($JOB,"RA D-TYPE")))
SET RAQUIT=0
Begin DoDot:1
+6 SET ^TMP($JOB,"RA I-TYPE",$PIECE(RAONE,"^"),$PIECE(RAONE,"^",2))=""
+7 QUIT
End DoDot:1
QUIT
+8 ; .... chk if only 1 img type within selectable division is available
+9 ; raimgnum = number of selectable img types
+10 IF $DATA(^TMP($JOB,"RA D-TYPE"))
Begin DoDot:1
+11 DO SETUP1
SET RAIMGNUM=$$IMGNUM^RAUTL7A()
+12 QUIT
End DoDot:1
+13 IF $DATA(^TMP($JOB,"RA D-TYPE"))
IF (RAIMGNUM=1)
Begin DoDot:1
+14 NEW RA0,RA1
+15 SET RA1=+$ORDER(^TMP($JOB,"DIV-IMG",0))
SET RA0=$PIECE($GET(^RA(79.2,RA1,0)),"^")
+16 SET ^TMP($JOB,"RA I-TYPE",RA0,RA1)=""
+17 QUIT
End DoDot:1
SET RAQUIT=0
QUIT
+18 SET RADIC="^RA(79.2,"
SET RADIC(0)="QEAMZ"
SET RAUTIL="RA I-TYPE"
+19 SET RADIC("A")="Select Imaging Type: "
SET RADIC("B")="All"
+20 IF $DATA(^TMP($JOB,"RA D-TYPE"))
Begin DoDot:1
+21 SET RADIC("S")="I $D(^TMP($J,""DIV-IMG"",+Y)),($D(RACCESS(DUZ,""IMG"",+Y)))"
+22 QUIT
End DoDot:1
+23 ; why do we need to check the alternative ? DIVLOC+3 prevents this
+24 ; alternative from occurring.
+25 IF '$TEST
SET RADIC("S")="I $D(RACCESS(DUZ,""IMG"",+Y))"
+26 WRITE !!
DO EN1^RASELCT(.RADIC,RAUTIL)
KILL %W,%Y1,DIC,RADIC,RAUTIL,X,Y
+27 QUIT
SELRADIO ; Setup ^TMP($J,"RA EITHER",ien file 50)
+1 SET RAINPUT=""
+2 KILL DIR,X,Y
SET DIR(0)="YA"
SET DIR("B")="Yes"
+3 SET DIR("A")="Do you wish to include all Radiopharms ? "
+4 SET DIR("?",1)="Enter 'Yes' to select all Radiopharms."
+5 SET DIR("?")="Enter 'No' to select a subset of Radiopharms."
+6 WRITE !
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
QUIT
+7 SET RAINPUT=+Y
KILL DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+8 IF RAINPUT
QUIT
+9 SET RADIC="^PSDRUG("
SET RADIC(0)="QEAMZ"
+10 SET RADIC("A")="Select Radiopharm: "
+11 WRITE !!
DO EN2^RAPSAPI(.RADIC,"RA EITHER")
KILL %W,%Y1,DIC,RADIC,RAUTIL,X,Y
+12 QUIT
SELADMIN ; Setup ^TMP($J,"RA EITHER",ien file 50)
+1 SET RAINPUT=""
+2 KILL DIR,X,Y
SET DIR(0)="YA"
SET DIR("B")="Yes"
+3 SET DIR("A")="Do you wish to include all who administered dose ? "
+4 SET DIR("?",1)="Enter 'Yes' to select all who administered dose."
+5 SET DIR("?")="Enter 'No' to select some who administered dose."
+6 WRITE !
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
QUIT
+7 SET RAINPUT=+Y
KILL DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+8 IF RAINPUT
QUIT
+9 SET RADIC="^VA(200,"
SET RADIC(0)="QEAMZ"
SET RAUTIL="RA EITHER"
+10 SET RADIC("A")="Select Person Who Admin Dose: "
+11 ; passed parameters to circumvent person's inactive date
+12 ; only the 4th param, 0, is really used to choose staff/resid/tech
+13 ;
SET RADIC("S")="I $$VALADM^RADD1(1,+Y,1,0)"
+14 WRITE !!
DO EN1^RASELCT(.RADIC,RAUTIL)
KILL %W,%Y1,DIC,RADIC,RAUTIL,X,Y
+15 QUIT
SELDATES ; Define RADTBEG and RADTEND
+1 SET RAPOP=0
WRITE !!,"**** Date Range Selection ****"
+2 WRITE !
SET %DT="APEXT"
+3 SET %DT("A")=" Beginning DATE : "
+4 SET %DT("B")="T-1"
+5 DO ^%DT
IF Y<0
SET RAPOP=1
IF Y<0
QUIT
SET (%DT(0),RADTBEG)=Y
+6 WRITE !
SET %DT="APEXT"
+7 SET %DT("A")=" Ending DATE : "
+8 SET %DT("B")="T-1@24:00"
+9 DO ^%DT
KILL %DT
IF Y<0
SET RAPOP=1
IF Y<0
QUIT
SET RADTEND=Y
+10 ; for display in header
SET RADTBEG("X")=$$FMTE^XLFDT(RADTBEG,1)
+11 SET RADTEND("X")=$$FMTE^XLFDT(RADTEND,1)
+12 IF $PIECE(RADTEND,".",2)=""
SET RADTEND=RADTEND_".9999"
+13 QUIT
SELSORT ; select sort order
+1 WRITE !
SET RAPOP=0
SET RASORT=0
+2 SET DIR("A")="Sort Exam Date/Time before "_$SELECT(RATITLE["Usage":"Radiopharm",1:"Who Admin Dose")_" ? : "
+3 SET DIR(0)="YAO"
SET DIR("B")="NO"
DO ^DIR
+4 IF $DATA(DIRUT)!($DATA(DUOUT))
SET RAPOP=1
QUIT
+5 ; 1=YES, 0=NO
SET RASORT=Y
+6 QUIT
SETUP1 ; Setup ^TMP($J,"DIV-IMG",Imaging Type IEN)=""
+1 ; based upon ^TMP($J,"RA D-TYPE",Division name)
+2 ; RACCESS "DIV-IMG"
+3 ; elements.
+4 NEW RAX,RAY,RAZ
SET RAX=""
+5 FOR
SET RAX=$ORDER(^TMP($JOB,"RA D-TYPE",RAX))
IF RAX']""
QUIT
Begin DoDot:1
+6 IF $DATA(RACCESS(DUZ,"DIV-IMG",RAX))
Begin DoDot:2
+7 SET RAY=""
FOR
SET RAY=$ORDER(RACCESS(DUZ,"DIV-IMG",RAX,RAY))
IF RAY']""
QUIT
Begin DoDot:3
+8 ;file 79.2's RADIOPHARM..USED
IF $PIECE($GET(^RA(79.2,+$ORDER(^RA(79.2,"B",RAY,0)),0)),U,5)'="Y"
QUIT
+9 SET RAZ=+$ORDER(^RA(79.2,"B",RAY,0))
SET ^TMP($JOB,"DIV-IMG",RAZ)=""
+10 QUIT
End DoDot:3
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 QUIT
