Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RADD2

RADD2.m

Go to the documentation of this file. 
  1. RADD2 ;HISC/GJC/CAH-Radiology Data Dictionary Utility Routine ; Feb 11, 2021@11:10:54
  1.  ;;5.0;Radiology/Nuclear Medicine;**84,47,124,158,175**;Mar 16, 1998;Build 2
  1.  ;
  1.  ;Integration Agreements
  1.  ;----------------------
  1.  ;EN^DDIOL(10142); FILE^DIE(2053);NOTE^ORX3(868);MES^XPDUTL(10141)
  1.  ;
  1. EN1(RA71) ; Input transform for the .01 field (Procedure) for the Rad/Nuc
  1.  ; Med Common Procedure file i.e, ^RAMIS(71.3 (reworked for RA*5.0*158)
  1.  ; Procedure must not have an inactive date before today in file 71
  1.  ; Procedure in file 71 must have same imaging type as the one
  1.  ;   selected before editing this record in file 71.3
  1.  ;
  1.  ; A PARENT type procedure must have at least one descendent
  1.  ; Output:
  1.  ; -If at least one descendant return one
  1.  ; -else return 0
  1.  ;
  1.  ; Input:
  1.  ; RA71 = IENS of entries in ^RAMIS(71,
  1.  ; RAIMGTYI = IEN of an IMAGING TYPE record (global scope)
  1.  ;
  1.  Q:'$G(RAIMGTYI) 0
  1.  ;
  1.  S RA71("I")=$G(^RAMIS(71,+RA71,"I")),RA71(0)=$G(^RAMIS(71,+RA71,0))
  1.  ;parent procedure?
  1.  S RAPARENT=$S($P(RA71(0),"^",6)="P":1,1:0)
  1.  ;does the parent have a descendant?
  1.  S:RAPARENT RAPFLG=+$O(^RAMIS(71,+RA71,4,0))
  1.  ;
  1.  ;if no "I" node or "I" node null ok, if DT is before today ok, else not ok
  1.  S RA71ACTIVE=$S(RA71("I")="":1,DT<RA71("I"):1,1:0)
  1.  Q:RA71ACTIVE=0 0
  1.  ;
  1.  ;match i-type?
  1.  S RA71ITYPE=$S(RAIMGTYI=$P($G(RA71(0)),"^",12):1,1:0)
  1.  Q:RA71ITYPE=0 0
  1.  ;
  1.  ;if active, w/i-type match & non-parent quit 1
  1.  Q:RAPARENT=0 1
  1.  ;
  1.  ;if active, w/i-type match & parent w/descendant quit 1
  1.  Q:RAPARENT&RAPFLG 1
  1.  ;
  1.  K RA71ACTIVE,RA71ITYPE,RAPARENT,RAPFLG
  1.  Q 0
  1.  ;
  1. CH ;this tag was removed w/RA*5.0*175
  1.  Q
  1.  ;
  1. INACOM(RAD0) ; Check inactive date on the Rad/Nuc Med Procedure file (71)
  1.  ; for the Common Procedure before setting our inactive procedure to
  1.  ; active.  Called from the 'RA COMMON PROCEDURE EDIT' input template.
  1.  ; Option: Common Procedure Enter/Edit (13^RAMAIN2)
  1.  ; Input : RAD0-ien of Rad/Nuc Med Common Procedure
  1.  ; Output: if Common cannot be re-activated, reset the 'Inactive' field
  1.  ;         to 'yes'.
  1.  N RAINA S RAINA=$P($G(^RAMIS(71,+$P($G(^RAMIS(71.3,RAD0,0)),"^"),"I")),"^")
  1.  Q:RAINA=""!(RAINA>DT) "@15" ; we can inactivate the common
  1.  N RAFDA,RAMSG
  1.  S RAFDA(71.3,RAD0_",",4)="Y" D FILE^DIE("","RAFDA","") S RAMSG(1)=$C(7)
  1.  S RAMSG(2)="You cannot add this procedure to the common procedure list"
  1.  S RAMSG(3)="because it is inactivated in the Rad/Nuc Med Procedures file."
  1.  S RAMSG(4)="You must first re-activate the procedure through the 'Procedure"
  1.  S RAMSG(5)="Enter/Edit' option.",RAMSG(6)="" D MES^XPDUTL(.RAMSG)
  1.  Q "@10" ; reset 'Inactive' to 'yes', re-edit field.
  1.  ;
  1. EN2() ; called from ^DD(74,0,"ID","WRITE")
  1.  ; display long case #'s in the same print set as current record
  1.  N RA1,RA2
  1.  S RA1=0,RA2=""
  1.  ; F  S RA1=$O(^RARPT(Y,1,"B",RA1)) Q:'RA1  S RA2=RA2_$S(RA2="":"-",1:",-")_$P(RA1,"-",2)
  1.  F  S RA1=$O(^RARPT(Y,1,"B",RA1)) Q:'RA1  S RA2=RA2_$S(RA2="":"-",1:",-")_$P(RA1,"-",$L(RA1,"-"))  ;P47 to accommodate possible SSAN format
  1.  Q RA2
  1. USUAL(RADA,RAX) ; To insure that the USUAL DOSE value falls between the
  1.  ; HIGH ADULT DOSE and the LOW ADULT DOSE.
  1.  ; Input Variables:
  1.  ;     RADA -> top level/sub-file level IEN's
  1.  ;      RAX -> value input by the user
  1.  ; Output Variable: $S(1: value is accepted, 0: value not accepted)
  1.  ;
  1.  Q:RAX="" 0 ; X does not exist
  1.  N RA7108,RAH,RAL S RA7108=$G(^RAMIS(71,RADA(1),"NUC",RADA,0))
  1.  S RAH=$P(RA7108,"^",5),RAL=$P(RA7108,"^",6)
  1.  S RAH=$S(RAH="":99999.9999,1:RAH),RAL=$S(RAL="":.0001,1:RAL)
  1.  I (+RAX<RAL)!(+RAX>RAH) D  Q 0 ; value is not accepted
  1.  . N RARRY S RARRY(1)="The 'USUAL DOSE' must fall within the range of: "
  1.  . S RARRY(1)=RARRY(1)_RAL_" - "_RAH_" "
  1.  . D EN^DDIOL(.RARRY)
  1.  . Q
  1.  E  Q 1 ; value accepted
  1.  ;
  1. RANGE(RADA) ; Determine the range in which the 'USUAL DOSE' must fall
  1.  ; Input Variables:
  1.  ;     RADA  -> top level/sub-file level IEN's
  1.  ; Output Variable:
  1.  ;     RANGE -> the range in which the 'USUAL DOSE' must fall
  1.  N RA7108,RAH,RAL
  1.  S RA7108=$G(^RAMIS(71,RADA(1),"NUC",RADA,0))
  1.  S RAH=$P(RA7108,"^",5),RAL=$P(RA7108,"^",6)
  1.  S RAH=$S(RAH="":99999.9999,1:RAH),RAL=$S(RAL="":.0001,1:RAL)
  1.  Q RAL_"-"_RAH
  1. MEDOSE(RAY,RADT) ; Determine if this individual (RAY) is authorized to
  1.  ; administer medications.  Called from ^DD(70.15,4,12.1)
  1.  ; Input : RAY (pnt to 200) - the individual being checked at the moment 
  1.  ;         RADT - Date of the examination
  1.  ; Output: '1' - user is authorized to administer medications, else '0'
  1.  ;
  1.  Q:$D(^VA(200,"ARC","R",RAY)) 1 ; Rad/Nuc Med Class: Resident
  1.  Q:$D(^VA(200,"ARC","S",RAY)) 1 ; Rad/Nuc Med Class: Staff
  1.  Q:$D(^VA(200,"ARC","T",RAY)) 1 ; Rad/Nuc Med Class: Technologist
  1.  Q:$D(^XUSEC("ORES",RAY)) 1 Q:$D(^XUSEC("ORELSE",RAY)) 1
  1.  N RAUTH S RAUTH=$G(^VA(200,RAY,"PS"))
  1.  ; If authorized to write med orders ($P(RAUTH,"^")=1) and inactivation
  1.  ; date null -OR- inactivation date greater than or equal to the exam
  1.  ; date individual is authorized.
  1.  Q:+$P(RAUTH,"^")&($S('$P(RAUTH,"^",4):1,$P(RAUTH,"^",4)'<RADT:1,1:0)) 1
  1.  Q 0
  1.  ;
  1. PRIDXIXK(DA,X) ;This subroutine executes the KILL logic for the 'new style' AD cross-
  1.  ;reference on the 'PRIMARY DIAGNOSTIC CODE' (data dictionary: 70.03; field: 13)
  1.  ;Input: DA - an array where DA(2)=RADFN, DA(1)=RADTI, & DA=RACNI
  1.  ;        X - the primary diagnostic code value (this field points to file 78.3)
  1.  N RACNI,RADFN,RADTI,RAFDA,RAIENS,RAX
  1.  S RADFN=DA(2),RADTI=DA(1),RACNI=DA,RAX=X ;save the variables just in case
  1.  S RAIENS=DA_","_DA(1)_","_DA(2)_",",RAFDA(70.03,RAIENS,20)="@"
  1.  D FILE^DIE(,"RAFDA") ;delete data in 'DIAGNOSTIC PRINT DATE' (DD: 70.03; field: 20)
  1.  K ^RADPT("AD",RAX,RADFN,RADTI,RACNI)
  1.  Q
  1.  ;
  1. AEASSET(RAX,RADA,RAXREF) ;determine is the examination status of the
  1.  ;study is either CANCELED or COMPLETE. This routine will set the "AS"
  1.  ; or "AE" xref SET logic (new style). 
  1.  ;
  1.  ; Note: The first numeric subscript of the "AE" xref is the
  1.  ;       CASE NUMBER (70.03;.01). Since the .01 field cannot
  1.  ;       be changed because of business rules, the "AE" xref
  1.  ;       does not have set/kill logic in the CASE NUMBER field.
  1.  ;
  1.  ;       The first numeric subscript of the "AS" xref is the
  1.  ;       EXAMINATION STATUS IEN (70.03;3). 
  1.  ;
  1.  ;
  1.  ;input: RAX = value of 'X' passed into from ^DD(70.03,3,0)
  1.  ;             'X' is the IEN of a record in the EXAMINATION
  1.  ;             STATUS (#72) file.
  1.  ;      RADA = the DA array: DA(2) think RADFN, DA(1) think
  1.  ;             RADTI & DA think RACNI.
  1.  ;    RAXREF = one of two values: "AS" or "AE"
  1.  ;
  1.  ;
  1.  ;ORDER value for CANCELED is zero (0), ORDER value for CANCELED is nine (9)
  1.  ;ORDER values 0, 1 & 9 are RESERVED. RAIMGTY is set in the input transform
  1.  N RAIMGTY,RAY2,RAY3,RAY S RAY=$P($G(^RA(72,RAX,0)),U,3) ;ORDER value
  1.  Q:RAY=""  S RAY2=$G(^RADPT(RADA(2),"DT",RADA(1),0))
  1.  S RAY3=$G(^RADPT(RADA(2),"DT",RADA(1),"P",RADA,0)) ;70.03
  1.  S RAIMGTY=$P($G(^RA(79.2,+$P(RAY2,U,2),0)),U) Q:RAIMGTY=""
  1.  ;^RA(72,"AA","GENERAL RADIOLOGY",1,1)="" 4th subscript is ORDER,
  1.  ;the 5th is IEN of file 72
  1.  Q:'$D(^RA(72,"AA",RAIMGTY,RAY,RAX))#2  ;the "AA" must be preserved
  1.  Q:RAY=0!(RAY=9)  ;the study is canceled or complete or broken
  1.  S:RAXREF="AE"&($P(RAY3,U)>0) ^RADPT("AE",$E(+RAY3,1,30),RADA(2),RADA(1),RADA)=""
  1.  S:RAXREF="AS" ^RADPT("AS",$E(RAX,1,30),RADA(2),RADA(1),RADA)=""
  1.  Q
  1.  ;
  1. AEKILL(RADA) ;execute the KILL logic for the "AE" xref on the
  1.  ;EXAM STATUS field (70.03;3)
  1.  ;input: RADA = the DA array: DA(2) think RADFN, DA(1) think
  1.  ;              & DA think RACNI.
  1.  N RAY3 S RAY3=$G(^RADPT(RADA(2),"DT",RADA(1),"P",RADA,0)) ;70.03
  1.  K ^RADPT("AE",$E(+RAY3,1,30),RADA(2),RADA(1),RADA)
  1.  Q
  1.  ;