source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RADD2.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

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