1 | RADD2 ;HISC/GJC/CAH-Radiology Data Dictionary Utility Routine ;5/14/97 10:31
|
---|
2 | ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
|
---|
3 | EN1(RAX,RAY) ; Input transform for the .01 field (Procedure) for the Rad/Nuc
|
---|
4 | ; Med Common Procedure file i.e, ^RAMIS(71.3
|
---|
5 | ; Procedure must not have an inactive date before today in file 71
|
---|
6 | ; Procedure in file 71 must have same imaging type as the one
|
---|
7 | ; selected before editing this record in file 71.3
|
---|
8 | ; If 'Parent' type procedure, it must have at least 1 descendent
|
---|
9 | ; 'RAX' is the value of the .01 field in ^RAMIS(71.3,
|
---|
10 | ; 'RAY' are ien's of entries in ^RAMIS(71,
|
---|
11 | I '$G(RAIMGTYI) Q 0
|
---|
12 | I $S('$D(^("I")):1,'^("I"):1,DT'>^("I"):1,1:0),$S(RAIMGTYI=$P($G(^RAMIS(71,+RAY,0)),"^",12):1,1:0),$S($P(^RAMIS(71,+RAY,0),U,6)'="P":1,$O(^RAMIS(71,+RAY,4,0)):1,1:0)
|
---|
13 | Q $T
|
---|
14 | ;
|
---|
15 | CH(RAY,RAX) ; This subroutine will fire off the 'Radiology Request Cancel
|
---|
16 | ; /Hold' notification as defined in the 'OE/RR NOTIFICATIONS' file.
|
---|
17 | ; Only if request is either cancelled or held. Called from the set
|
---|
18 | ; logic of the 'ACHN' xref in ^DD(75.1,5) field definition.
|
---|
19 | ;
|
---|
20 | ; Input variables:
|
---|
21 | ; 'RAX'=Request status of the order, $S(X=1:'discontinued',X=3:'hold')
|
---|
22 | ; 'RAY'=ien of the order in the RAD/NUC MED ORDERS file.
|
---|
23 | ;
|
---|
24 | Q:(RAY'=+RAY) Q:(RAX'=1)&(RAX'=3)
|
---|
25 | N %,C,D,D0,DA,DC,DDER,DE,DG,DH,DI,DIC,DIE,DIEDA,DIEL,DIFLD,DIP,DIW,DIWT
|
---|
26 | N DK,DL,DM,DN,DP,DQ,DR,DU,DV,DW,I,J,N,ORBPMSG,ORBXDATA,ORIFN,ORNOTE,ORVP
|
---|
27 | N RA751,RADFN,RANME,RAOIFN,RAOLP,RAOPTN,RAORDS,RAOREA,RAOSTS,RAPARENT
|
---|
28 | N RAPRC,RAXIT,X,Y
|
---|
29 | S RA751=$G(^RAO(75.1,RAY,0)) Q:RA751']""
|
---|
30 | S RAOIFN=RAY,RADFN=+$P(RA751,"^")
|
---|
31 | S RAPRC=$P($G(^RAMIS(71,+$P(RA751,"^",2),0)),"^"),ORVP=RADFN_";DPT("
|
---|
32 | S ORBPMSG=$S(RAX=1:"Discontinued - ",1:"On hold - ")_$E(RAPRC,1,17)
|
---|
33 | S ORBXDATA=RAOIFN_","_RADFN,ORIFN=+$P(RA751,"^",7),ORNOTE(26)=1
|
---|
34 | D NOTE^ORX3
|
---|
35 | Q
|
---|
36 | INACOM(RAD0) ; Check inactive date on the Rad/Nuc Med Procedure file (71)
|
---|
37 | ; for the Common Procedure before setting our inactive procedure to
|
---|
38 | ; active. Called from the 'RA COMMON PROCEDURE EDIT' input template.
|
---|
39 | ; Option: Common Procedure Enter/Edit (13^RAMAIN2)
|
---|
40 | ; Input : RAD0-ien of Rad/Nuc Med Common Procedure
|
---|
41 | ; Output: if Common cannot be re-activated, reset the 'Inactive' field
|
---|
42 | ; to 'yes'.
|
---|
43 | N RAINA S RAINA=$P($G(^RAMIS(71,+$P($G(^RAMIS(71.3,RAD0,0)),"^"),"I")),"^")
|
---|
44 | Q:RAINA=""!(RAINA>DT) "@15" ; we can inactivate the common
|
---|
45 | N RAFDA,RAMSG
|
---|
46 | S RAFDA(71.3,RAD0_",",4)="Y" D FILE^DIE("","RAFDA","") S RAMSG(1)=$C(7)
|
---|
47 | S RAMSG(2)="You cannot add this procedure to the common procedure list"
|
---|
48 | S RAMSG(3)="because it is inactivated in the Rad/Nuc Med Procedures file."
|
---|
49 | S RAMSG(4)="You must first re-activate the procedure through the 'Procedure"
|
---|
50 | S RAMSG(5)="Enter/Edit' option.",RAMSG(6)="" D MES^XPDUTL(.RAMSG)
|
---|
51 | Q "@10" ; reset 'Inactive' to 'yes', re-edit field.
|
---|
52 | ;
|
---|
53 | EN2() ; called from ^DD(74,0,"ID","WRITE")
|
---|
54 | ; display long case #'s in the same print set as current record
|
---|
55 | N RA1,RA2
|
---|
56 | S RA1=0,RA2=""
|
---|
57 | F S RA1=$O(^RARPT(Y,1,"B",RA1)) Q:'RA1 S RA2=RA2_$S(RA2="":"-",1:",-")_$P(RA1,"-",2)
|
---|
58 | Q RA2
|
---|
59 | USUAL(RADA,RAX) ; To insure that the USUAL DOSE value falls between the
|
---|
60 | ; HIGH ADULT DOSE and the LOW ADULT DOSE.
|
---|
61 | ; Input Variables:
|
---|
62 | ; RADA -> top level/sub-file level IEN's
|
---|
63 | ; RAX -> value input by the user
|
---|
64 | ; Output Variable: $S(1: value is accepted, 0: value not accepted)
|
---|
65 | ;
|
---|
66 | Q:RAX="" 0 ; X does not exist
|
---|
67 | N RA7108,RAH,RAL S RA7108=$G(^RAMIS(71,RADA(1),"NUC",RADA,0))
|
---|
68 | S RAH=$P(RA7108,"^",5),RAL=$P(RA7108,"^",6)
|
---|
69 | S RAH=$S(RAH="":99999.9999,1:RAH),RAL=$S(RAL="":.0001,1:RAL)
|
---|
70 | I (+RAX<RAL)!(+RAX>RAH) D Q 0 ; value is not accepted
|
---|
71 | . N RARRY S RARRY(1)="The 'USUAL DOSE' must fall within the range of: "
|
---|
72 | . S RARRY(1)=RARRY(1)_RAL_" - "_RAH_" "
|
---|
73 | . D EN^DDIOL(.RARRY)
|
---|
74 | . Q
|
---|
75 | E Q 1 ; value accepted
|
---|
76 | ;
|
---|
77 | RANGE(RADA) ; Determine the range in which the 'USUAL DOSE' must fall
|
---|
78 | ; Input Variables:
|
---|
79 | ; RADA -> top level/sub-file level IEN's
|
---|
80 | ; Output Variable:
|
---|
81 | ; RANGE -> the range in which the 'USUAL DOSE' must fall
|
---|
82 | N RA7108,RAH,RAL
|
---|
83 | S RA7108=$G(^RAMIS(71,RADA(1),"NUC",RADA,0))
|
---|
84 | S RAH=$P(RA7108,"^",5),RAL=$P(RA7108,"^",6)
|
---|
85 | S RAH=$S(RAH="":99999.9999,1:RAH),RAL=$S(RAL="":.0001,1:RAL)
|
---|
86 | Q RAL_"-"_RAH
|
---|
87 | MEDOSE(RAY,RADT) ; Determine if this individual (RAY) is authorized to
|
---|
88 | ; administer medications. Called from ^DD(70.15,4,12.1)
|
---|
89 | ; Input : RAY (pnt to 200) - the individual being checked at the moment
|
---|
90 | ; RADT - Date of the examination
|
---|
91 | ; Output: '1' - user is authorized to administer medications, else '0'
|
---|
92 | ;
|
---|
93 | Q:$D(^VA(200,"ARC","R",RAY)) 1 ; Rad/Nuc Med Class: Resident
|
---|
94 | Q:$D(^VA(200,"ARC","S",RAY)) 1 ; Rad/Nuc Med Class: Staff
|
---|
95 | Q:$D(^VA(200,"ARC","T",RAY)) 1 ; Rad/Nuc Med Class: Technologist
|
---|
96 | Q:$D(^XUSEC("ORES",RAY)) 1 Q:$D(^XUSEC("ORELSE",RAY)) 1
|
---|
97 | N RAUTH S RAUTH=$G(^VA(200,RAY,"PS"))
|
---|
98 | ; If authorized to write med orders ($P(RAUTH,"^")=1) and inactivation
|
---|
99 | ; date null -OR- inactivation date greater than or equal to the exam
|
---|
100 | ; date individual is authorized.
|
---|
101 | Q:+$P(RAUTH,"^")&($S('$P(RAUTH,"^",4):1,$P(RAUTH,"^",4)'<RADT:1,1:0)) 1
|
---|
102 | Q 0
|
---|