- RARTUTL1 ;HIRMFO/GJC-Utility to display Pharm & Radiopharm data ;11/18/97 13:28
- ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
- ;
- RDIO1(RADA) ; Display Radiopharmaceutical default data for Report displays
- ; Input: RADA -> ien of the Nuc Med Exam Data record (file 70.2)
- ; Output: 'X' -> $S(X'="":'abnormal exit',1:'full display')
- ; *** Called only if $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,28)>0 ***
- N RADARY,RAXIT,Y S RAXIT=0,X=""
- D GETS^DIQ(70.2,RADA_",","**","NE","RADARY") Q:'$D(RADARY) ""
- D WAIT^RART1:($Y+6)>IOSL&('$D(RARTVERF)) Q:X="T"!(X="P")!(X="^") X
- I X="C" W @IOF S X=""
- N RAIENS S RAIENS=""
- F S RAIENS=$O(RADARY(70.21,RAIENS)) Q:RAIENS="" D Q:RAXIT
- . N RADOSE S RADOSE=$S($G(RADARY(70.21,RAIENS,7,"E"))]"":", "_$G(RADARY(70.21,RAIENS,7,"E"))_" mCi",1:"")
- . D WAIT^RART1:($Y+6)>IOSL&('$D(RARTVERF)) S:X="T"!(X="P")!(X="^") RAXIT=1
- . Q:RAXIT
- . I X="C" W @IOF S X=""
- . W !," Radiopharmaceutical: "_$G(RADARY(70.21,RAIENS,.01,"E"))_RADOSE
- . D WAIT^RART1:($Y+6)>IOSL&('$D(RARTVERF)) S:X="T"!(X="P")!(X="^") RAXIT=1
- . Q:RAXIT
- . I X="C" W @IOF S X=""
- . Q:$G(RADARY(70.21,RAIENS,8,"E"))=""&($G(RADARY(70.21,RAIENS,9,"E"))="")&($G(RADARY(70.21,RAIENS,11,"E"))="")&($G(RADARY(70.21,RAIENS,12,"E"))="")
- . N RACNT,RALNGTH S RACNT=0
- . F RADFLDS=8,9,11,12 D
- .. W:'RACNT&(RADFLDS=8) ! ; initial line feed, spacing
- .. I $G(RADARY(70.21,RAIENS,RADFLDS,"E"))]"" D
- ... W:RACNT=2 ! S:RACNT=2 RACNT=0 ; NEW LINE
- ... S RACNT=RACNT+1
- ... W:RADFLDS=8 $S(RACNT=2:" Adm'd on ",1:" Adm'd on ")
- ... W:RADFLDS=9 $S(RACNT=2:" by ",1:" by ")
- ... W:RADFLDS=11 $S(RACNT=2:" Route ",1:" Route ")
- ... W:RADFLDS=12 $S(RACNT=2:" Site ",1:" Site ")
- ... S RALNGTH=$L($G(RADARY(70.21,RAIENS,RADFLDS,"E")))
- ... I RACNT=2,((RALNGTH+$X)>IOM) D
- .... W $E($G(RADARY(70.21,RAIENS,RADFLDS,"E")),1,(IOM-($X-1)))
- .... Q
- ... E W $G(RADARY(70.21,RAIENS,RADFLDS,"E"))
- ... Q
- .. Q
- . Q
- Q $G(X)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRARTUTL1 1963 printed Feb 19, 2025@00:05:54 Page 2
- RARTUTL1 ;HIRMFO/GJC-Utility to display Pharm & Radiopharm data ;11/18/97 13:28
- +1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
- +2 ;
- RDIO1(RADA) ; Display Radiopharmaceutical default data for Report displays
- +1 ; Input: RADA -> ien of the Nuc Med Exam Data record (file 70.2)
- +2 ; Output: 'X' -> $S(X'="":'abnormal exit',1:'full display')
- +3 ; *** Called only if $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,28)>0 ***
- +4 NEW RADARY,RAXIT,Y
- SET RAXIT=0
- SET X=""
- +5 DO GETS^DIQ(70.2,RADA_",","**","NE","RADARY")
- if '$DATA(RADARY)
- QUIT ""
- +6 if ($Y+6)>IOSL&('$DATA(RARTVERF))
- DO WAIT^RART1
- if X="T"!(X="P")!(X="^")
- QUIT X
- +7 IF X="C"
- WRITE @IOF
- SET X=""
- +8 NEW RAIENS
- SET RAIENS=""
- +9 FOR
- SET RAIENS=$ORDER(RADARY(70.21,RAIENS))
- if RAIENS=""
- QUIT
- Begin DoDot:1
- +10 NEW RADOSE
- SET RADOSE=$SELECT($GET(RADARY(70.21,RAIENS,7,"E"))]"":", "_$GET(RADARY(70.21,RAIENS,7,"E"))_" mCi",1:"")
- +11 if ($Y+6)>IOSL&('$DATA(RARTVERF))
- DO WAIT^RART1
- if X="T"!(X="P")!(X="^")
- SET RAXIT=1
- +12 if RAXIT
- QUIT
- +13 IF X="C"
- WRITE @IOF
- SET X=""
- +14 WRITE !," Radiopharmaceutical: "_$GET(RADARY(70.21,RAIENS,.01,"E"))_RADOSE
- +15 if ($Y+6)>IOSL&('$DATA(RARTVERF))
- DO WAIT^RART1
- if X="T"!(X="P")!(X="^")
- SET RAXIT=1
- +16 if RAXIT
- QUIT
- +17 IF X="C"
- WRITE @IOF
- SET X=""
- +18 if $GET(RADARY(70.21,RAIENS,8,"E"))=""&($GET(RADARY(70.21,RAIENS,9,"E"))="")&($GET(RADARY(70.21,RAIENS,11,"E"))="")&($GET(RADARY(70.21,RAIENS,12,"E"))="")
- QUIT
- +19 NEW RACNT,RALNGTH
- SET RACNT=0
- +20 FOR RADFLDS=8,9,11,12
- Begin DoDot:2
- +21 ; initial line feed, spacing
- if 'RACNT&(RADFLDS=8)
- WRITE !
- +22 IF $GET(RADARY(70.21,RAIENS,RADFLDS,"E"))]""
- Begin DoDot:3
- +23 ; NEW LINE
- if RACNT=2
- WRITE !
- if RACNT=2
- SET RACNT=0
- +24 SET RACNT=RACNT+1
- +25 if RADFLDS=8
- WRITE $SELECT(RACNT=2:" Adm'd on ",1:" Adm'd on ")
- +26 if RADFLDS=9
- WRITE $SELECT(RACNT=2:" by ",1:" by ")
- +27 if RADFLDS=11
- WRITE $SELECT(RACNT=2:" Route ",1:" Route ")
- +28 if RADFLDS=12
- WRITE $SELECT(RACNT=2:" Site ",1:" Site ")
- +29 SET RALNGTH=$LENGTH($GET(RADARY(70.21,RAIENS,RADFLDS,"E")))
- +30 IF RACNT=2
- IF ((RALNGTH+$X)>IOM)
- Begin DoDot:4
- +31 WRITE $EXTRACT($GET(RADARY(70.21,RAIENS,RADFLDS,"E")),1,(IOM-($X-1)))
- +32 QUIT
- End DoDot:4
- +33 IF '$TEST
- WRITE $GET(RADARY(70.21,RAIENS,RADFLDS,"E"))
- +34 QUIT
- End DoDot:3
- +35 QUIT
- End DoDot:2
- +36 QUIT
- End DoDot:1
- if RAXIT
- QUIT
- +37 QUIT $GET(X)