- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRANMUTL1 3959 printed Feb 19, 2025@00:03:49 Page 2
- 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