- 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/RASTREQN.m
r613 r623 1 RASTREQN ;HIRMFO/GJC-Status Requirement check for Radiopharms ;11/18/97 15:13 2 ;;5.0;Radiology/Nuclear Medicine;**40,65**;Mar 16, 1998;Build 8 3 ; 4 ;supported IA #10104 reference to UP^XLFSTR and REPEAT^XLFSTR 5 ;Supported IA #2056 refernce to GETS^DIQ 6 ; 7 ; *** 'RASTREQN' is called from routine: 'RASTREQ' *** 8 EN1(RADIO,RAJ) ; Check if all the required radiopharmaceutical data has 9 ; been entered for this particular Examination Status. 10 ; *=*=*= Kills 'X' if the status cannot be updated =*=*=* 11 ; Input: 'RADIO' -> .5 node of the examination status (Radiopharms req) 12 ; 'RAJ' -> 0 node of the examination 13 ; 14 ; NOTE: RAMES1 is set in RASTREQ^RASTREQ subroutine. Only the 'Status 15 ; Tracking Of Exams' option displays which required fields are not 16 ; populated for the next available Exam Status. 17 ; 18 ;---------------------------------------------------------------------- 19 ; Determine if 'Radiopharmaceutical' is required 20 ; RAPRI defined in [RA STATUS CHANGE] & [RA EXAM EDIT] 21 ; 22 Q:"N"[$P(RADIO,"^") ; Rpharms & Dosages NOT Req'd (either 'no' or null) 23 N RAPROC S RAPROC(0)=$G(^RAMIS(71,+$P(RAJ,"^",2),0)) 24 Q:$P(RAPROC(0),"^",2)=1 ; Never ask Rpharms & Dosages 25 ;---------------------------------------------------------------------- 26 N RA702 S RA702=+$P(RAJ,"^",28) ; ien in NUC MED EXAM DATA (70.2) file 27 N RA7021,RACNT,RAI,RAMES2,RAREQ,RAZ S RAI=0 28 I 'RA702,($P(RADIO,"^")="Y") D Q 29 . K X S RAZ="Radiopharmaceutical" X:$D(RAMES1) RAMES1 30 . Q 31 F S RAI=$O(^RADPTN(RA702,"NUC",RAI)) Q:RAI'>0 D 32 . S RA7021=$G(^RADPTN(RA702,"NUC",RAI,0)),RACNT=0 33 . S RAMES2="W:$G(K)=$P($G(^RA(72,+$G(RANXT72),0)),U,3)&('$D(ZTQUEUED)#2) !,""Radiopharmaceutical: "",$$EN1^RAPSAPI(+$P(RA7021,""^""),.01)" 34 . I $P(RADIO,"^")="Y",($P(RA7021,"^")=""!($P(RA7021,"^",7)="")) D 35 .. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 36 .. I $P(RA7021,"^")="" S RAZ="Radiopharmaceutical" X:$D(RAMES1) RAMES1 37 .. I $P(RA7021,"^",7)="" S RAZ="Dosage" X:$D(RAMES1) RAMES1 38 .. Q 39 . I $P(RADIO,"^",3)="Y",($P(RA7021,"^",4)="") D 40 .. S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 41 .. S RAZ="Activity Drawn" X:$D(RAMES1) RAMES1 K X 42 .. Q 43 . I $P(RADIO,"^",4)="Y",($P(RA7021,"^",5)=""!($P(RA7021,"^",6)="")) D 44 .. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 45 .. I $P(RA7021,"^",5)="" S RAZ="Date/Time Drawn" X:$D(RAMES1) RAMES1 46 .. I $P(RA7021,"^",6)="" S RAZ="Person Who Measured Dose" X:$D(RAMES1) RAMES1 47 .. Q 48 . I $P(RADIO,"^",5)="Y",($P(RA7021,"^",8)=""!($P(RA7021,"^",9)="")) D 49 .. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 50 .. I $P(RA7021,"^",8)="" S RAZ="Date/Time Dose Administered" X:$D(RAMES1) RAMES1 51 .. I $P(RA7021,"^",9)="" S RAZ="Person Who Administered Dose" X:$D(RAMES1) RAMES1 52 .. Q 53 . I $P(RADIO,"^",7)="Y",($P(RA7021,"^",11)=""!($P(RA7021,"^",12)="")) D 54 .. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 55 .. I $P(RA7021,"^",11)="" S RAZ="Route Of Administration" X:$D(RAMES1) RAMES1 56 .. I $P(RA7021,"^",12)="" S RAZ="Site Of Administration" X:$D(RAMES1) RAMES1 57 .. Q 58 . I $P(RADIO,"^",8)="Y",($P(RA7021,"^",13)="") D 59 .. S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 60 .. S RAZ="Lot No." X:$D(RAMES1) RAMES1 K X 61 .. Q 62 . I $P(RADIO,"^",9)="Y",($P(RA7021,"^",14)=""!($P(RA7021,"^",15)="")) D 63 .. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 64 .. I $P(RA7021,"^",14)="" S RAZ="Volume" X:$D(RAMES1) RAMES1 65 .. I $P(RA7021,"^",15)="" S RAZ="Form" X:$D(RAMES1) RAMES1 66 .. Q 67 . Q 68 Q 69 NORADIO(RAPRI,RANXT72) ; This function will determine if Rpharm 70 ; fields from the 'Nuc Med Exam Data' file [ ^RADPTN( ] will be asked. 71 ; Input : 'RANXT72' -> .6 node of the 'Next' Exam Status 72 ; : 'RAPRI' -> IEN of the procedure for this exam 73 ; Output: '1' bypass Rpharm questions, else (0) ask 74 Q:$TR($$UP^XLFSTR(RANXT72(.6)),"^","")="" 1 ; null or '^'s 75 ; ------------------- Variable Definitions ---------------------------- 76 ; 'RAPROC(2)': ask Rpharm & Dosages parameter for this procedure 77 ;---------------------------------------------------------------------- 78 N RAPROC S RAPROC(2)=$P($G(^RAMIS(71,RAPRI,0)),"^",2) 79 ;---------------------------------------------------------------------- 80 ; * following conditions apply for descendants exams & single exams * 81 ; * Number 1: Suppress Rpharm = 1 even if 'Rpharms/Dose' Req'd * 82 ; * Number 2: Suppress Rpharm = null or 0, 'Rpharm/Dose' not req'd * 83 Q:RAPROC(2)=1 1 84 Q:"N"[$P(RANXT72(.6),"^") 1 85 ;---------------------------------------------------------------------- 86 Q 0 ; ask Rpharm & Dosage fields 87 DISDEF(RADA) ; Display Radiopharmaceutical default data 88 ; called from input templs: [RASTATUS CHANGE] and [RA EXAM EDIT] 89 ; Input: RADA -> ien of the Nuc Med Exam Data record 90 Q:'$O(^RADPTN(RADA,"NUC",0)) ; Radiopharms missing, no data 91 N RADARY,RADEUC,RAFLDS,RAIENS,RAOPUT,X,Y W ! 92 S RAIENS="" D GETS^DIQ(70.2,RADA_",","**","NE","RADARY") 93 F S RAIENS=$O(RADARY(70.21,RAIENS)) Q:RAIENS="" D 94 . Q:$P(RAIENS,",",2)="" ; top-level of the file 95 . S (RADEUC,RAFLDS)=0 96 . F S RAFLDS=$O(RADARY(70.21,RAIENS,RAFLDS)) Q:RAFLDS'>0 D Q:$D(DIRUT) 97 .. I RAFLDS=.01 D 98 ... S RADEUC=0 W !,$G(RADARY(70.21,RAIENS,RAFLDS,"E")) 99 ... W !,$$REPEAT^XLFSTR("-",$L($G(RADARY(70.21,RAIENS,RAFLDS,"E")))),! 100 ... Q 101 .. E D 102 ... S RADEUC=RADEUC+1 103 ... S RAOPUT=$$TRAN(RAFLDS)_$G(RADARY(70.21,RAIENS,RAFLDS,"E"))_$S(RAFLDS=2:" mCi",RAFLDS=4:" mCi",RAFLDS=7:" mCi",1:"") 104 ... W:RADEUC=1 $E(RAOPUT,1,38) W:RADEUC=2 ?39,$E(RAOPUT,1,39) 105 ... Q 106 .. W:RADEUC'=2&($O(RADARY(70.21,RAIENS,RAFLDS))="") ! 107 .. W:RADEUC=2 ! S:RADEUC=2 RADEUC=0 108 .. Q 109 . Q 110 Q 111 TRAN(X) ; Translate field name to a shorter length. 112 Q:X=2 "Dose (MD Override): " Q:X=3 "Prescriber: " 113 Q:X=4 "Activity Drawn: " Q:X=5 "Drawn: " Q:X=6 "Measured By: " 114 Q:X=7 "Dose Adm'd: " Q:X=8 "Date Adm'd: " Q:X=9 "Adm'd By: " 115 Q:X=10 "Witness: " Q:X=11 "Route: " Q:X=12 "Site: " 116 Q:X=12.5 "Site Text: " Q:X=13 "Lot #: " Q:X=14 "Volume: " 117 Q:X=15 "Form: " 118 VALDOS(RALOW,RAHI,X,RABACKTO,RAGOTO,RALASTAG,RAWARN) ;validate drawn/dose 119 ; Called from [RA STATUS CHANGE] and [RA EXAM EDIT] input templates. 120 ; Validate the value for either : 121 ; ACTIVITY DRAWN (fld 4, DD: 70.21) 122 ; DOSE (fld 7, DD: 70.21) 123 ; If there are limits on the Dosage, validate. 124 ; If validate fails, ask user if the invalid value is to be accepted. 125 ; If yes, proceed. 126 ; If no, re-ask DOSE. 127 ; Input: RAHI = Upper limit on dosage 128 ; RALOW = Lower limit on dosage 129 ; X = Value user input 130 ; RABACKTO = Previous Line tag to loop back to if need re-ask 131 ; RAGOTO = Default linetag to proceed to if within range 132 ; RALASTAG = Last linetag in this edit template if early out 133 ; RAWARN = display/not the warning msg -- 0=no, 1=yes 134 ; 135 ; Output: RAY = linetag to proceed to after exiting this check 136 ; 137 N RAY,RAYN S RAY="" I X']"" S RAY=RAGOTO G KVAL 138 S:RALOW=""&(RAHI="") RAY=RAGOTO 139 S:RALOW]""&(RAHI="")&(X'<RALOW) RAY=RAGOTO 140 S:RALOW=""&(RAHI]"")&(X'>RAHI) RAY=RAGOTO 141 S:RALOW]""&(RAHI]"")&(X'<RALOW)&(X'>RAHI) RAY=RAGOTO 142 I RAY="" D 143 . F D Q:RAY]"" 144 .. I $O(^RA(79,RAMDIV,"RWARN",0)) D:RAWARN 145 ... N I S I=0 146 ... F S I=$O(^RA(79,RAMDIV,"RWARN",I)) Q:I'>0 W !,$G(^(I,0)) 147 ... Q 148 .. E D:RAWARN 149 ... W !,"This dose requires a written, dated and signed directive by" 150 ... W !,"a physician." 151 ... Q 152 .. W !!?3,"Are you sure (Y/N)?: N//" R RAYN:DTIME 153 .. I '$T!(RAYN["^") S RAY=RALASTAG Q 154 .. S RAYN=$S(RAYN']"":"N",1:$$UP^XLFSTR($E(RAYN))) 155 .. S RAY=$S(RAYN="N":RABACKTO,RAYN="Y":RAGOTO,1:"") 156 .. I RAY="" W !!?3,"Enter 'Yes' if this value is acceptable, or 'No' if this field is to be",!?3,"re-edited.",$C(7) 157 .. Q 158 . Q 159 KVAL K RABACKTO,RAGOTO,RALASTAG,RAWARN 160 Q RAY 1 RASTREQN ;HIRMFO/GJC-Status Requirement check for Radiopharms ;11/18/97 15:13 2 ;;5.0;Radiology/Nuclear Medicine;**40**;Mar 16, 1998 3 ; 4 ; *** 'RASTREQN' is called from routine: 'RASTREQ' *** 5 EN1(RADIO,RAJ) ; Check if all the required radiopharmaceutical data has 6 ; been entered for this particular Examination Status. 7 ; *=*=*= Kills 'X' if the status cannot be updated =*=*=* 8 ; Input: 'RADIO' -> .5 node of the examination status (Radiopharms req) 9 ; 'RAJ' -> 0 node of the examination 10 ; 11 ; NOTE: RAMES1 is set in RASTREQ^RASTREQ subroutine. Only the 'Status 12 ; Tracking Of Exams' option displays which required fields are not 13 ; populated for the next available Exam Status. 14 ; 15 ;---------------------------------------------------------------------- 16 ; Determine if 'Radiopharmaceutical' is required 17 ; RAPRI defined in [RA STATUS CHANGE] & [RA EXAM EDIT] 18 ; 19 Q:"N"[$P(RADIO,"^") ; Rpharms & Dosages NOT Req'd (either 'no' or null) 20 N RAPROC S RAPROC(0)=$G(^RAMIS(71,+$P(RAJ,"^",2),0)) 21 Q:$P(RAPROC(0),"^",2)=1 ; Never ask Rpharms & Dosages 22 ;---------------------------------------------------------------------- 23 N RA702 S RA702=+$P(RAJ,"^",28) ; ien in NUC MED EXAM DATA (70.2) file 24 N RA7021,RACNT,RAI,RAMES2,RAREQ,RAZ S RAI=0 W:'$D(ZTQUEUED)#2 ! 25 I 'RA702,($P(RADIO,"^")="Y") D Q 26 . K X S RAZ="Radiopharmaceutical" X:$D(RAMES1) RAMES1 27 . Q 28 F S RAI=$O(^RADPTN(RA702,"NUC",RAI)) Q:RAI'>0 D 29 . S RA7021=$G(^RADPTN(RA702,"NUC",RAI,0)),RACNT=0 30 . S RAMES2="W:$G(K)=$P($G(^RA(72,+$G(RANXT72),0)),U,3)&('$D(ZTQUEUED)#2) !,""Radiopharmaceutical: "",$$GET1^DIQ(50,+$P(RA7021,""^"")_"","",.01)" 31 . I $P(RADIO,"^")="Y",($P(RA7021,"^")=""!($P(RA7021,"^",7)="")) D 32 .. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 33 .. I $P(RA7021,"^")="" S RAZ="Radiopharmaceutical" X:$D(RAMES1) RAMES1 34 .. I $P(RA7021,"^",7)="" S RAZ="Dosage" X:$D(RAMES1) RAMES1 35 .. Q 36 . I $P(RADIO,"^",3)="Y",($P(RA7021,"^",4)="") D 37 .. S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 38 .. S RAZ="Activity Drawn" X:$D(RAMES1) RAMES1 K X 39 .. Q 40 . I $P(RADIO,"^",4)="Y",($P(RA7021,"^",5)=""!($P(RA7021,"^",6)="")) D 41 .. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 42 .. I $P(RA7021,"^",5)="" S RAZ="Date/Time Drawn" X:$D(RAMES1) RAMES1 43 .. I $P(RA7021,"^",6)="" S RAZ="Person Who Measured Dose" X:$D(RAMES1) RAMES1 44 .. Q 45 . I $P(RADIO,"^",5)="Y",($P(RA7021,"^",8)=""!($P(RA7021,"^",9)="")) D 46 .. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 47 .. I $P(RA7021,"^",8)="" S RAZ="Date/Time Dose Administered" X:$D(RAMES1) RAMES1 48 .. I $P(RA7021,"^",9)="" S RAZ="Person Who Administered Dose" X:$D(RAMES1) RAMES1 49 .. Q 50 . I $P(RADIO,"^",7)="Y",($P(RA7021,"^",11)=""!($P(RA7021,"^",12)="")) D 51 .. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 52 .. I $P(RA7021,"^",11)="" S RAZ="Route Of Administration" X:$D(RAMES1) RAMES1 53 .. I $P(RA7021,"^",12)="" S RAZ="Site Of Administration" X:$D(RAMES1) RAMES1 54 .. Q 55 . I $P(RADIO,"^",8)="Y",($P(RA7021,"^",13)="") D 56 .. S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 57 .. S RAZ="Lot No." X:$D(RAMES1) RAMES1 K X 58 .. Q 59 . I $P(RADIO,"^",9)="Y",($P(RA7021,"^",14)=""!($P(RA7021,"^",15)="")) D 60 .. K X S RACNT=RACNT+1 X:$D(RAMES1)&(RACNT=1) RAMES2 61 .. I $P(RA7021,"^",14)="" S RAZ="Volume" X:$D(RAMES1) RAMES1 62 .. I $P(RA7021,"^",15)="" S RAZ="Form" X:$D(RAMES1) RAMES1 63 .. Q 64 . W:'$D(ZTQUEUED)#2 ! ; spacing 65 . Q 66 Q 67 NORADIO(RAPRI,RANXT72) ; This function will determine if Rpharm 68 ; fields from the 'Nuc Med Exam Data' file [ ^RADPTN( ] will be asked. 69 ; Input : 'RANXT72' -> .6 node of the 'Next' Exam Status 70 ; : 'RAPRI' -> IEN of the procedure for this exam 71 ; Output: '1' bypass Rpharm questions, else (0) ask 72 Q:$TR($$UP^XLFSTR(RANXT72(.6)),"^","")="" 1 ; null or '^'s 73 ; ------------------- Variable Definitions ---------------------------- 74 ; 'RAPROC(2)': ask Rpharm & Dosages parameter for this procedure 75 ;---------------------------------------------------------------------- 76 N RAPROC S RAPROC(2)=$P($G(^RAMIS(71,RAPRI,0)),"^",2) 77 ;---------------------------------------------------------------------- 78 ; * following conditions apply for descendants exams & single exams * 79 ; * Number 1: Suppress Rpharm = 1 even if 'Rpharms/Dose' Req'd * 80 ; * Number 2: Suppress Rpharm = null or 0, 'Rpharm/Dose' not req'd * 81 Q:RAPROC(2)=1 1 82 Q:"N"[$P(RANXT72(.6),"^") 1 83 ;---------------------------------------------------------------------- 84 Q 0 ; ask Rpharm & Dosage fields 85 DISDEF(RADA) ; Display Radiopharmaceutical default data 86 ; Input: RADA -> ien of the Nuc Med Exam Data record 87 Q:'$O(^RADPTN(RADA,"NUC",0)) ; Radiopharms missing, no data 88 N RADARY,RADEUC,RAFLDS,RAIENS,RAOPUT,X,Y W ! 89 S RAIENS="" D GETS^DIQ(70.2,RADA_",","**","NE","RADARY") 90 F S RAIENS=$O(RADARY(70.21,RAIENS)) Q:RAIENS="" D 91 . Q:$P(RAIENS,",",2)="" ; top-level of the file 92 . S (RADEUC,RAFLDS)=0 93 . F S RAFLDS=$O(RADARY(70.21,RAIENS,RAFLDS)) Q:RAFLDS'>0 D Q:$D(DIRUT) 94 .. I RAFLDS=.01 D 95 ... S RADEUC=0 W !,$G(RADARY(70.21,RAIENS,RAFLDS,"E")) 96 ... W !,$$REPEAT^XLFSTR("-",$L($G(RADARY(70.21,RAIENS,RAFLDS,"E")))),! 97 ... Q 98 .. E D 99 ... S RADEUC=RADEUC+1 100 ... S RAOPUT=$$TRAN(RAFLDS)_$G(RADARY(70.21,RAIENS,RAFLDS,"E"))_$S(RAFLDS=2:" mCi",RAFLDS=4:" mCi",RAFLDS=7:" mCi",1:"") 101 ... W:RADEUC=1 $E(RAOPUT,1,38) W:RADEUC=2 ?39,$E(RAOPUT,1,39) 102 ... Q 103 .. W:RADEUC'=2&($O(RADARY(70.21,RAIENS,RAFLDS))="") ! 104 .. W:RADEUC=2 ! S:RADEUC=2 RADEUC=0 105 .. Q 106 . Q 107 Q 108 TRAN(X) ; Translate field name to a shorter length. 109 Q:X=2 "Dose (MD Override): " Q:X=3 "Prescriber: " 110 Q:X=4 "Activity Drawn: " Q:X=5 "Drawn: " Q:X=6 "Measured By: " 111 Q:X=7 "Dose Adm'd: " Q:X=8 "Date Adm'd: " Q:X=9 "Adm'd By: " 112 Q:X=10 "Witness: " Q:X=11 "Route: " Q:X=12 "Site: " 113 Q:X=12.5 "Site Text: " Q:X=13 "Lot #: " Q:X=14 "Volume: " 114 Q:X=15 "Form: " 115 VALDOS(RALOW,RAHI,X,RABACKTO,RAGOTO,RALASTAG,RAWARN) ;validate drawn/dose 116 ; Called from [RA STATUS CHANGE] and [RA EXAM EDIT] input templates. 117 ; Validate the value for either : 118 ; ACTIVITY DRAWN (fld 4, DD: 70.21) 119 ; DOSE (fld 7, DD: 70.21) 120 ; If there are limits on the Dosage, validate. 121 ; If validate fails, ask user if the invalid value is to be accepted. 122 ; If yes, proceed. 123 ; If no, re-ask DOSE. 124 ; Input: RAHI = Upper limit on dosage 125 ; RALOW = Lower limit on dosage 126 ; X = Value user input 127 ; RABACKTO = Previous Line tag to loop back to if need re-ask 128 ; RAGOTO = Default linetag to proceed to if within range 129 ; RALASTAG = Last linetag in this edit template if early out 130 ; RAWARN = display/not the warning msg -- 0=no, 1=yes 131 ; 132 ; Output: RAY = linetag to proceed to after exiting this check 133 ; 134 N RAY,RAYN S RAY="" I X']"" S RAY=RAGOTO G KVAL 135 S:RALOW=""&(RAHI="") RAY=RAGOTO 136 S:RALOW]""&(RAHI="")&(X'<RALOW) RAY=RAGOTO 137 S:RALOW=""&(RAHI]"")&(X'>RAHI) RAY=RAGOTO 138 S:RALOW]""&(RAHI]"")&(X'<RALOW)&(X'>RAHI) RAY=RAGOTO 139 I RAY="" D 140 . F D Q:RAY]"" 141 .. I $O(^RA(79,RAMDIV,"RWARN",0)) D:RAWARN 142 ... N I S I=0 143 ... F S I=$O(^RA(79,RAMDIV,"RWARN",I)) Q:I'>0 W !,$G(^(I,0)) 144 ... Q 145 .. E D:RAWARN 146 ... W !,"This dose requires a written, dated and signed directive by" 147 ... W !,"a physician." 148 ... Q 149 .. W !!?3,"Are you sure (Y/N)?: N//" R RAYN:DTIME 150 .. I '$T!(RAYN["^") S RAY=RALASTAG Q 151 .. S RAYN=$S(RAYN']"":"N",1:$$UP^XLFSTR($E(RAYN))) 152 .. S RAY=$S(RAYN="N":RABACKTO,RAYN="Y":RAGOTO,1:"") 153 .. I RAY="" W !!?3,"Enter 'Yes' if this value is acceptable, or 'No' if this field is to be",!?3,"re-edited.",$C(7) 154 .. Q 155 . Q 156 KVAL K RABACKTO,RAGOTO,RALASTAG,RAWARN 157 Q RAY
Note:
See TracChangeset
for help on using the changeset viewer.
