136 lines
5.9 KiB
Mathematica
136 lines
5.9 KiB
Mathematica
RADD3 ;HISC/SWM-Radiology Data Dictionary Utility Routine ;9/11/97 16:23
|
|
;;5.0;Radiology/Nuclear Medicine;**18**;Mar 16, 1998
|
|
PAIR ;
|
|
; if editing SOURCE for new (laygo) LOT entry in file 71.9
|
|
; then re-set DR string to stuff matching radiopharm
|
|
; and don't allow spacebar return for radioph
|
|
I $D(RAOPT("EDITPT"))!($D(RAOPT("EDITCN")))!($D(RAOPT("STATRACK"))) D
|
|
. I $G(DR)[";5",$G(DIE)="^RAMIS(71.9,",+$G(RAPSDRUG),$P($G(^PSDRUG(+$G(RAPSDRUG),0)),U)]"" S DR=$P(DR,";5")_";5///"_$P($G(^PSDRUG(+$G(RAPSDRUG),0)),U)_$P(DR,";5",2,99) K ^DISV(DUZ,"^RAMIS(71.9,")
|
|
. Q
|
|
; check pairing of number/id with source
|
|
; called by input transform of file 71.9'S field 2 (source)
|
|
N RA1,RA2,RA3 S (RA1,RA2,RA3)=""
|
|
Q:$G(DA)="" Q:$G(D)=""
|
|
F S RA1=$O(^RAMIS(71.9,"B",$P(D,U),RA1)) Q:'RA1 I DA'=RA1 S:$P(^RAMIS(71.9,RA1,0),U,2)=+Y RA2=1 ;found a match so set ra2=1
|
|
W:RA2 !!,"** There's already a NUMBER/ID=",$P(D,U)," and SOURCE=",$P(Y,U,2)," **",!
|
|
K:RA2 X
|
|
Q
|
|
SCRLOT() ;screen lot # from file 70.2
|
|
;lot's exp. dt must be within d/t dose admin, if no admin, use exam dt
|
|
; if lot's exp. dt is null, allow as choice (don't check)
|
|
;lot's radiopharm must match exam's radiopharm
|
|
; if lot's radiopharm is null, don't allow as choice
|
|
;Y pointer to lot file
|
|
;RA0A date/time dose administered
|
|
;RA0E date/time exam
|
|
;RALOTEXP lot's expiration date
|
|
;RA0RAD exam's radiopharmaceutical
|
|
;RALOTRAD lot's radiopharmaceutical
|
|
;RARETUR return value of screen, 0=failed, 1=passed
|
|
I '$D(Y)#2!('$D(DA))!('$D(DA(1))) Q 0
|
|
N RA0A,RA0E,RALOTEXP,RA0RAD,RALOTRAD,RARETURN
|
|
S RARETURN=0
|
|
S RA0E=$P(^RADPTN(DA(1),0),U,2),RA0A=$P(^("NUC",DA,0),U,8),RA0RAD=$P(^(0),U),RALOTEXP=$P(^RAMIS(71.9,+Y,0),U,3),RALOTRAD=$P(^(0),U,5)
|
|
I $S(RALOTEXP="":1,RA0A:RALOTEXP>RA0A,1:RALOTEXP>RA0E),(RA0RAD=RALOTRAD) S RARETURN=1
|
|
Q RARETURN
|
|
;
|
|
GETID(Y) ; Pass back a string of data which will be used as an
|
|
; identifier when lookups are done on the Imaging Locations (79.1) file
|
|
; Input : Y -> ien of entry in 79.1
|
|
; Output: string of data relevent to the entry in file 79.1
|
|
; Location I-type_"-"_Station # of Rad/Nuc Med Division
|
|
N RA791 S RA791(0)=$G(^RA(79.1,Y,0))
|
|
S RA791("DIV")=$G(^RA(79.1,Y,"DIV"))
|
|
Q "("_$$GET1^DIQ(79.2,+$P(RA791(0),"^",6),.01)_"-"_$$GET1^DIQ(4,+$P(RA791("DIV"),"^"),99)_")"
|
|
;
|
|
DELDESC(RAIEN) ; This sub-routine will determine if descendents can be
|
|
; deleted from parent procedures. If only one descendent exists, and
|
|
; the parent is on the common procedure list do not allow the deletion
|
|
; of the descendent.
|
|
; Input : RAIEN (the DA array for the Rad/Nuc Med Procedure file.)
|
|
; Output: 0 if ok to delete, 1 if not ok to delete
|
|
; Called from: ^DD(71.05,.01,"DEL",1,0) node
|
|
N I,RA713,RATTL S (I,RA713,RATTL)=0
|
|
S:$D(^RAMIS(71.3,"B",RAIEN(1))) RA713=+$O(^RAMIS(71.3,"B",RAIEN(1),0))
|
|
S:RA713>0 RA713(0)=$G(^RAMIS(71.3,RA713,0))
|
|
F S I=$O(^RAMIS(71,RAIEN(1),4,I)) Q:I'>0 S RATTL=RATTL+1
|
|
I RA713,($P(RA713(0),"^",5)=""),(RATTL=1) D Q 1
|
|
. ; don't allow deletion of the last descendent on procedures that are
|
|
. ; currently active in the common procedure file.
|
|
. N RATXT S RATXT(1)=" "
|
|
. S RATXT(2)="You cannot delete the last or only descendent from a"
|
|
. S RATXT(3)="parent procedure when the parent procedure is an active"
|
|
. S RATXT(4)="common procedure.",RATXT(5)=$C(7) D EN^DDIOL(.RATXT)
|
|
. Q
|
|
Q 0 ; common procedure with more than one descendent, ok to delete
|
|
;
|
|
REACMMN(RADA) ; Check to see if a commom procedure can be re-activated.
|
|
; This sub-routine checks if this common is a parent w/o descendents.
|
|
; If true, this common procedure cannot be re-activated.
|
|
; Input : RADA - ien of the entry in 71.3
|
|
; Output: 0 if ok to delete, 1 if not ok to delete
|
|
; Called from ^DD(71.3,4,"DEL",1,0)
|
|
N RA713 S RA713=$G(^RAMIS(71.3,RADA,0))
|
|
I $P($G(^RAMIS(71,+RA713,0)),"^",6)="P",('$O(^RAMIS(71,+RA713,4,0))) D Q 1
|
|
. N RATXT S RATXT(1)=" "
|
|
. S RATXT(2)="You cannot re-activate a common parent procedure without descendents."
|
|
. S RATXT(3)=$C(7) D EN^DDIOL(.RATXT)
|
|
. Q
|
|
Q 0 ; ok to delete
|
|
;
|
|
X7005(RADFN,RADTI,RACNI,RAMDV,RAQED,RASTI,RAWHO) ;update the EXAM
|
|
; STATUS TIMES (70.05) multiple. Called from RASTED (will be
|
|
; called from RAUTL1 in the future)
|
|
;
|
|
; input variables:
|
|
; ----------------
|
|
; RADFN=patient dfn, RADTI=exam date/time (inverse)
|
|
; RACNI=exam record ien (70.03), RAMDV=division parameters
|
|
; RAQED=task queued(1=yes;0=no), RASTI=exam status
|
|
; RAWHO=editing person
|
|
;
|
|
N %,D,D0,DA,DIC,DIE,DQ,DR,RAFDA,RAIEN,RAIENS,X,Y
|
|
S RAQED=+$G(RAQED) ; if tasked 1, else 0
|
|
S RAIENS="+1,"_RACNI_","_RADTI_","_RADFN_","
|
|
S RAFDA(70.05,RAIENS,.01)=$$MIDNGHT^RAUTL5($$NOW^XLFDT())
|
|
D UPDATE^DIE(,"RAFDA","RAIEN") ; RAIEN(1)=ien of new record
|
|
K RAFDA,RAIENS Q:'$D(RAIEN(1)) ; record not added
|
|
I $P(RAMDV,"^",11),('RAQED) D
|
|
.S DIE="^RADPT("_RADFN_",""DT"","_RADTI_",""P"","_RACNI_",""T"","
|
|
.S DA=RAIEN(1),DR=".01" D ^DIE
|
|
S RAIENS=RAIEN(1)_","_RACNI_","_RADTI_","_RADFN_","
|
|
S RAFDA(70.05,RAIENS,2)=RASTI
|
|
S RAFDA(70.05,RAIENS,3)=$G(RAWHO)
|
|
D FILE^DIE(,"RAFDA")
|
|
Q
|
|
A7007(RADFN,RADTI,RACNI,RAWHO,RATC) ; update the ACTIVITY LOG (70.07)
|
|
; multiple. Called from RASTED (will be called from RAUTL1 in the
|
|
; future)
|
|
;
|
|
; input variables:
|
|
; ----------------
|
|
; RADFN=patient dfn, RADTI=exam date/time (inverse)
|
|
; RACNI=exam record ien (70.03), RAWHO=editing person
|
|
; RATC=technologist comments (optional)
|
|
;
|
|
N %,D,D0,DA,DIC,DIE,DQ,DR,RAFDA,RAIEN,RAIENS,X,Y
|
|
S RAIENS="+1,"_RACNI_","_RADTI_","_RADFN_","
|
|
S RAFDA(70.07,RAIENS,.01)="NOW"
|
|
D UPDATE^DIE("E","RAFDA","RAIEN") ;RAIEN(1)=ien of new record
|
|
K RAFDA,RAIENS Q:'$D(RAIEN(1)) ; record not added
|
|
S RAIENS=RAIEN(1)_","_RACNI_","_RADTI_","_RADFN_","
|
|
S RAFDA(70.07,RAIENS,2)="U"
|
|
S RAFDA(70.07,RAIENS,3)=$G(RAWHO)
|
|
S:$G(RATC)]"" RAFDA(70.07,RAIENS,4)=RATC
|
|
D FILE^DIE(,"RAFDA")
|
|
Q
|
|
;
|
|
;updates EXAM STATUS
|
|
U70033(RA18DFN,RA18DTI,RA18CNI,RA18ST) ;
|
|
N %,D,D0,DA,DIC,DIE,DQ,DR,RA18FDA,RA18IENS,X,Y
|
|
S RA18IENS=RA18CNI_","_RA18DTI_","_RA18DFN_","
|
|
S RA18FDA(70.03,RA18IENS,3)=RA18ST
|
|
D FILE^DIE(,"RA18FDA")
|
|
Q
|
|
;
|