- 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/RADD2.m
r613 r623 1 RADD2 ;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 ; 8 EN1(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 ; 20 CH(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 41 INACOM(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 ; 58 EN2() ; 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 64 USUAL(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 ; 82 RANGE(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 92 MEDOSE(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 ; 109 PRIDXIXK(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 ; 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
Note:
See TracChangeset
for help on using the changeset viewer.
