| 1 | RADD1 ;HISC/FPT-Radiology Utility Routine ;6/2/98 16:17
|
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;**1,5,10,65**;Mar 16, 1998;Build 8
|
|---|
| 3 | ;
|
|---|
| 4 | ;Supported IA #10142 reference to EN^DDIOL
|
|---|
| 5 | ;Supported IA #10103 reference to FMADD^XLFDT
|
|---|
| 6 | ;
|
|---|
| 7 | SECXREF ; sets/kills 'ARES' & 'ASTF' x-refs for secondary resident/staff rads
|
|---|
| 8 | ; called from ^DD(74,5
|
|---|
| 9 | ;
|
|---|
| 10 | Q:'$D(^RARPT(DA,0)) S RADFNZ=^(0)
|
|---|
| 11 | S RADTIZ=9999999.9999-$P(RADFNZ,"^",3),RACNIZ=$O(^RADPT(+$P(RADFNZ,"^",2),"DT",RADTIZ,"P","B",+$P(RADFNZ,"^",4),0)),RADFNZ=+$P(RADFNZ,"^",2)
|
|---|
| 12 | I 'RACNIZ D KILL Q
|
|---|
| 13 | I '$D(^RADPT(RADFNZ,"DT",RADTIZ,"P",RACNIZ,0)) D KILL Q
|
|---|
| 14 | I '$D(^RADPT(RADFNZ,"DT",RADTIZ,"P",RACNIZ,RASECOND,0)) D KILL Q
|
|---|
| 15 | S RASECIEN=0
|
|---|
| 16 | F S RASECIEN=$O(^RADPT(RADFNZ,"DT",RADTIZ,"P",RACNIZ,RASECOND,RASECIEN)) Q:RASECIEN<1 S RARAD=+$P($G(^(RASECIEN,0)),"^",1) I RARAD>0 D
|
|---|
| 17 | .S:$D(RASET) ^RARPT(RAXREF,RARAD,DA)="" K:$D(RAKILL) ^RARPT(RAXREF,RARAD,DA)
|
|---|
| 18 | D XSEC^RAUTL20
|
|---|
| 19 | KILL K RACNIZ,RADFNZ,RADTIZ,RASECOND,RASECIEN
|
|---|
| 20 | Q
|
|---|
| 21 | SCDTC ; status change date/time check
|
|---|
| 22 | ; called from ^DD(70.05,.01
|
|---|
| 23 | ; if X is a date/time prior to the exam date/time, then set Y=0.
|
|---|
| 24 | ; if X is a over a minute in the future, then set Y=0.
|
|---|
| 25 | ; if X is missing the time portion, then set Y=0.
|
|---|
| 26 | I '($D(X)#2) Q
|
|---|
| 27 | I '$F(X,".") D EN^DDIOL("** Time is Required **","","!!?20") S Y=0 Q
|
|---|
| 28 | N RASTATUS,RAORDNUM,RAPLUS1
|
|---|
| 29 | ; eg. da(3)=1128, da(2)=7028970.8743,da(1)=1,da=1
|
|---|
| 30 | S RASTATUS=$P($G(^RADPT(+$G(DA(3)),"DT",+$G(DA(2)),"P",+$G(DA(1)),0)),U,3)
|
|---|
| 31 | S RAORDNUM=$P($G(^RA(72,+RASTATUS,0)),U,3)
|
|---|
| 32 | I X<(9999999.9999-$G(DA(2))),RAORDNUM>1 S Y=0 Q
|
|---|
| 33 | S RADTHOLD=X
|
|---|
| 34 | D NOW^%DTC
|
|---|
| 35 | ; 2/25/98 allow entry to be at most 1 minute after current time
|
|---|
| 36 | S RAPLUS1=%,RAPLUS1=$$FMADD^XLFDT(RAPLUS1,0,0,1,0)
|
|---|
| 37 | I RADTHOLD>RAPLUS1 S Y=0
|
|---|
| 38 | S X=RADTHOLD
|
|---|
| 39 | K RADTHOLD
|
|---|
| 40 | Q
|
|---|
| 41 | PDC() ; do not enter secondary into primary diagnostic code field
|
|---|
| 42 | ; called from ^DD(70.03,13,0)
|
|---|
| 43 | ; do not select inactive diagnostic code 12/23/96
|
|---|
| 44 | I $P(^RA(78.3,+Y,0),U,5)="Y" Q 0
|
|---|
| 45 | I $D(^RADPT(DA(2),"DT",DA(1),"P",DA,"DX","B",+Y)) Q 0
|
|---|
| 46 | Q 1
|
|---|
| 47 | SDC() ; do not enter primary into secondary diagnostic code field
|
|---|
| 48 | ; called from ^DD(70.14,.01,0)
|
|---|
| 49 | ; do not select inactive diagnostic code 12/23/96
|
|---|
| 50 | I $P(^RA(78.3,+Y,0),U,5)="Y" Q 0
|
|---|
| 51 | I '$D(X)!('$D(DA(3))) G SDC2
|
|---|
| 52 | I '$D(^RADPT(DA(3),"DT",DA(2),"P",DA(1),0)) G SDC2
|
|---|
| 53 | I $P(^RADPT(DA(3),"DT",DA(2),"P",DA(1),0),"^",13)=+Y Q 0
|
|---|
| 54 | Q 1
|
|---|
| 55 | SDC2 ;
|
|---|
| 56 | I '$D(X)!('$D(DA(2))) G SDC3
|
|---|
| 57 | I '$D(^RADPT(DA(2),"DT",DA(1),"P",DA,0)) Q 0
|
|---|
| 58 | I $P(^RADPT(DA(2),"DT",DA(1),"P",DA,0),"^",13)=+Y Q 0
|
|---|
| 59 | Q 1
|
|---|
| 60 | SDC3 ;
|
|---|
| 61 | I '$D(RADFN) Q 0
|
|---|
| 62 | S DA(2)=RADFN
|
|---|
| 63 | I '$D(^RADPT(DA(2),"DT",DA(1),"P",DA,0)) Q 0
|
|---|
| 64 | I $P(^RADPT(DA(2),"DT",DA(1),"P",DA,0),"^",13)=+Y Q 0
|
|---|
| 65 | Q 1
|
|---|
| 66 | NODEL ; no deletion of primary dx code, primary resident or staff if there
|
|---|
| 67 | ; is a secondary
|
|---|
| 68 | S RASECCHK=0,RASECCHK=$O(^RADPT(DA(2),"DT",DA(1),"P",DA,RAMULT,RASECCHK))
|
|---|
| 69 | I RASECCHK W " Required"
|
|---|
| 70 | K RAMULT,RASECCHK
|
|---|
| 71 | Q
|
|---|
| 72 | PRCCPT() ; Displays the procedure type and CPT code if applicable.
|
|---|
| 73 | ; This code is called from ^DD(71,0,"ID","WRITE") and rtn RAPROD
|
|---|
| 74 | N RA,RATXT S RA(0)=$G(^(0)),RA("I")=+$G(^("I")),RATXT=""
|
|---|
| 75 | S RA=$S('RA("I"):0,DT'>RA("I"):0,1:1)
|
|---|
| 76 | S RA(6)=$P(RA(0),U,6),RA(9)=$P(RA(0),U,9)
|
|---|
| 77 | S RA(12)=$P(RA(0),U,12) I 'RA(12) S RA(10)="UNKN "
|
|---|
| 78 | I '$D(RA(10)) S RA(10)=$P(^RA(79.2,+RA(12),0),U,3)_" "
|
|---|
| 79 | I $L(RA(10))<5 F S RA(10)=RA(10)_" " Q:$L(RA(10))>4
|
|---|
| 80 | S RATXT="("_RA(10)_$S(RA:"Inactive",RA(6)="B":"Broad ",RA(6)="D":"Detailed",RA(6)="P":"Parent ",RA(6)="S":"Series ",1:"Unknown ")_")"
|
|---|
| 81 | S:RA(9)]"" RATXT=RATXT_" CPT:"_$P($$NAMCODE^RACPTMSC(RA(9),DT),"^")
|
|---|
| 82 | Q RATXT
|
|---|
| 83 | INDTCHK(RADA) ; Cannot inactivate a procedure if it is a common procedure
|
|---|
| 84 | ; with a valid sequence number. Code resides in ^DD(71,100,0)!
|
|---|
| 85 | ; 'RADA' is the ien of the procedure in file 71. if this procedure is
|
|---|
| 86 | ; a common procedure i.e, $D(^RAMIS(71.3,"B",RADA)) inform the user that
|
|---|
| 87 | ; the sequence number must be deleted. This relies on the "AA" xref in
|
|---|
| 88 | ; the Common Proc. file for the Sequence # fld (#3) 0 node, 4th pce.
|
|---|
| 89 | N RA,RAIEN S RAIEN=+$O(^RAMIS(71.3,"B",RADA,0))
|
|---|
| 90 | S RA(0)=$G(^RAMIS(71.3,RAIEN,0)) Q:RA(0)']""
|
|---|
| 91 | S RA(4)=+$P(RA(0),"^",4) ; obtain the sequence number
|
|---|
| 92 | I $D(^RAMIS(71.3,"AA",$$EN3^RAUTL17(RADA),RA(4),RAIEN)) D ; sequence #?
|
|---|
| 93 | . N RATXT S RATXT(1)=" "
|
|---|
| 94 | . S RATXT(2)=" Cannot inactivate - this procedure is currently in the"
|
|---|
| 95 | . S RATXT(3)=" Rad/Nuc Med Common Procedure file with a sequence"
|
|---|
| 96 | . S RATXT(4)=" number. Please remove the sequence number thru the"
|
|---|
| 97 | . S RATXT(5)=" 'Common Procedure Enter/Edit' option before assigning"
|
|---|
| 98 | . S RATXT(6)=" an inactivation date to this procedure."
|
|---|
| 99 | . S RATXT(7)=" "
|
|---|
| 100 | . D EN^DDIOL(.RATXT) K X ; display message, can't input ANY date!
|
|---|
| 101 | . Q
|
|---|
| 102 | Q
|
|---|
| 103 | CPTCHK(RADA) ; Check if the CPT code is inactive nationally.
|
|---|
| 104 | ; 'RADA' assume the value of +Y passed from the input xform, ^DD(71,9,0)
|
|---|
| 105 | ; quit if CPT code is active
|
|---|
| 106 | ;
|
|---|
| 107 | Q:$$ACTCODE^RACPTMSC(RADA,DT)
|
|---|
| 108 | N RATXT S RATXT(1)=" "
|
|---|
| 109 | S RATXT(2)=" Warning - Nationally inactive CPT code."
|
|---|
| 110 | S RATXT(3)=" " D EN^DDIOL(.RATXT)
|
|---|
| 111 | K X
|
|---|
| 112 | Q
|
|---|
| 113 | ;
|
|---|
| 114 | VALADM(RAD0,Y,RADT,RAUTH) ;edit validation
|
|---|
| 115 | ;Used to validate/screen radiopharm dosage administrator,
|
|---|
| 116 | ; radiopharm prescribing phys, person who measured radiopharm dose,
|
|---|
| 117 | ;----------------------------------------------------------------------
|
|---|
| 118 | ; RAD0 : IEN of entry in question for NUC MED EXAM DATA (70.2) file
|
|---|
| 119 | ; Y : Pointer to the New Person file
|
|---|
| 120 | ; RADT : Xam Date; if not passed, calculate exam date from file 70.2
|
|---|
| 121 | ; RAUTH : 1 - only staff/resid, must be auth'zd to write med orders
|
|---|
| 122 | ; : 0 - staff/resid & tech's
|
|---|
| 123 | ;----------------------------------------------------------------------
|
|---|
| 124 | ; Output: '1' authorized to write med orders, else '0'
|
|---|
| 125 | ;----------------------------------------------------------------------
|
|---|
| 126 | Q $$VALADM^RADD4()
|
|---|
| 127 | ;
|
|---|
| 128 | VOL(RAX) ; Validate the format of the value input for volume.
|
|---|
| 129 | ; RAX must be a number followed by a space then text -or-
|
|---|
| 130 | ; a number followed by text
|
|---|
| 131 | ; Input Variable : 'RAX'- user's input
|
|---|
| 132 | ; Output Variable: null if 'RAX' erroneous, formatted version of 'RAX'
|
|---|
| 133 | Q $$VOL^RADD4()
|
|---|
