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

RAUTL14.m

Go to the documentation of this file.
  1. RAUTL14 ;HISC/GJC - Utilities for message display. ; Mar 07, 2024@13:17:03
  1. ;;5.0;Radiology/Nuclear Medicine;**34,208**;Mar 16, 1998;Build 4
  1. ;
  1. ;Supported IA #2055 reference to $$EXTERNAL^DILFD
  1. ;Supported IA #10142 reference to EN^DDIOL
  1. ;Supported IA #2053 reference to FILE^DIE
  1. ;
  1. EN1 ; Message display. Called from the input transform of the
  1. ;'TYPE OF IMAGING' field of the Imaging Locations file
  1. ; i.e, ^DD(79.1,6,0) --> D:'$D(^RA(79.1,"BIMG",+Y)) EN1^RAUTL14
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RATXT,RAX,RAY,RAYN
  1. S RAX=X,RAY=Y,RATXT(1)=" " K X,Y
  1. S RATXT(2)="** Caution: You are activating a new Imaging Type. **"
  1. S RATXT(3)=" This means you will have to assign procedures to"
  1. S RATXT(4)=" this imaging type. Workload reports will be printed"
  1. S RATXT(5)=" separately for this Imaging Type."
  1. S RATXT(6)=" " D EN^DDIOL(.RATXT) S DIR(0)="YA"
  1. S DIR("A")="Are you sure? "
  1. S DIR("?")="Enter 'Y' for yes, 'N' to re-edit this field."
  1. D ^DIR S RAYN=+Y K X,Y D EN^DDIOL(" ")
  1. S X=RAX,Y=RAY K:'RAYN X Q:'$D(X)
  1. I $D(^RA(79.2,"B","CARDIOLOGY STUDIES (NUC MED)",+Y)) K RATXT D
  1. . S RATXT(1)=" The 'CARDIOLOGY STUDIES' imaging type should not be"
  1. . S RATXT(2)=" activated unless nuclear cardiology is done separately"
  1. . S RATXT(3)=" from Nuclear Medicine at your facility."
  1. . D EN^DDIOL(.RATXT)
  1. . Q
  1. Q
  1. EN2 ; Message display. Called from input transform of the
  1. ;'TYPE OF IMAGING' field of the Rad/Nuc Med Procedure file
  1. ; i.e, ^DD(71,12,0) --> D EN2^RAUTL14
  1. I '$D(^RA(79.1,"BIMG",+Y)) D
  1. . N RATXT,X,Y S RATXT(1)=" "
  1. . S RATXT(2)="This Imaging Type has not been assigned to any Imaging Location."
  1. . S RATXT(3)="In order to register this procedure for patients, you must"
  1. . S RATXT(4)="assign this Imaging Type to an Imaging Location."
  1. . S RATXT(5)=" " D EN^DDIOL(.RATXT)
  1. . Q
  1. N RAD0,RASEQ
  1. S RAD0=+$O(^RAMIS(71.3,"B",D0,0)),RASEQ=$P($G(^RAMIS(71.3,RAD0,0)),U,4)
  1. I RASEQ D K X
  1. . N RATXT,X,Y S RATXT(1)=" "
  1. . S RATXT(2)="This procedure was found in the Rad/Nuc Med Common"
  1. . S RATXT(3)="Procedure file. To change its imaging type you must"
  1. . S RATXT(4)="first inactivate it in that file. After it is made"
  1. . S RATXT(5)="inactive you may change its imaging type. You can"
  1. . S RATXT(6)="then reactivate it if you wish."
  1. . S RATXT(7)=" " D EN^DDIOL(.RATXT)
  1. . Q
  1. Q
  1. UNI30(RADA,RAX) ; Determines if the 1st 30 chars of a procedure name are unique.
  1. ; If not, do not allow the user to add or alter the current procedure.
  1. ; Don't allow characters ; ^
  1. ; Called from the input transform in ^DD(71,.01,0)
  1. ; Pass back 1 if unique, 0 if a conflict.
  1. ; 'RA' ---> temporary variable to hold data
  1. ; 'RAX' ---> Input user wishes to enter/edit in ^RAMIS(71
  1. ; 'RADA' ---> IEN of the current entry in ^RAMIS(71,
  1. ; The first 30 do not match any other entries first 30
  1. N RA1,RA2,RABEG,RAEND,RAFLG1,RAFLG2,RALEN,RALST,RAPCE
  1. S (RAFLG1,RAFLG2)=0
  1. ;S RABEG=$E(RAX,1,30),RALEN=$L(RABEG),RALST=$E(RABEG,$L(RABEG))
  1. ;S RAEND=$E(RABEG,1,(RALEN-1))_$C(($A(RALST)-1))_"z"
  1. ;
  1. ; Check for bad characters in the procedure name: a semicolon
  1. I RAX[";" D EN^DDIOL("Entry must not contain a semicolon (;). ",,"!?12,$C(7)") Q 0
  1. ;
  1. ;
  1. S RA1=$O(^RAMIS(71,"B",RAX),-1) ; Obtain collating entry immediately
  1. ; before user input. Check 1st 30 of prior
  1. ; entry aginst 1st 30 of user entry.
  1. ; If different, ok!
  1. ;
  1. S:$E(RA1,1,30)'=$E(RAX,1,30) RAFLG1=1
  1. ;
  1. S RA2=$O(^RAMIS(71,"B",RAX)) ; Obtain the collating entry of
  1. S:$E(RA2,1,30)'=$E(RAX,1,30) RAFLG2=1 ; the entry immediately after the
  1. ; user input. If the 1st 30 of
  1. ; user input does not equal the
  1. ; 1st 30 of the next collating
  1. ; entry, the input is ok!
  1. ;
  1. ; Brand new entry
  1. I RADA=0 Q $S((RAFLG1+RAFLG2)>1:1,1:0)
  1. ;
  1. S RAPCE=$P($G(^RAMIS(71,RADA,0)),"^")
  1. I RADA,($E(RAPCE,1,30)=$E(RAX,1,30)) Q 1 ; 1st 30 chars of user input
  1. ; may equal the 1st 30 chars
  1. ; of the record we are editing.
  1. ;
  1. E Q $S((RAFLG1+RAFLG2)>1:1,1:0) ; The 1st thirty chars may have changed
  1. ; Check RAFLG1 & RAFLG2 for conflicts
  1. ; with any other data in the database.
  1. ;
  1. CHKPTYPE(OPTYP,APTYP) ;check the procedure type to ensure BROAD/PARENT procedures
  1. ; remain BROAD/PARENT procedures after editing the TYPE OF PROCEDURE
  1. ; (#6) field.
  1. ; Input: OPTYP = original procedure type value
  1. ; APTYP = after edit procedure type value
  1. ; Return: 0 if the procedure type value did not change
  1. ; 1 if there was a change in procedure type value
  1. Q:(OPTYP=APTYP) 0
  1. Q 1
  1. ;
  1. RSETPTYP(RAPIEN,OPTYP) ;PARENT and BROAD procedures cannot have their procedure
  1. ; types changed. Change the procedure back to the appropriate procedure
  1. ; type: PARENT (P) or BROAD (B). Called from the RA PROCEDURE EDIT input
  1. ; template.
  1. ;
  1. ; Input: RAPIEN = IEN of the procedure (file: #71) record being edited
  1. ; OPTYP = the original procedure type value
  1. ; Output: the original procedure type value (RAPTY will assume this value)
  1. ;
  1. N RAMSG,RAPTYNOW,RASTR
  1. ;Q1: what is the procedure type after the edit? RAPTYNOW
  1. S RAPTYNOW=$P($G(^RAMIS(71,RAPIEN,0)),U,6) ;B, D, P or S?
  1. ;if the original was 'D' or 'S' and if the ptype changes
  1. ;to 'D' or 'S' accept it & return the updated ptype value (RAPTYNOW)
  1. I "^D^S^"[("^"_OPTYP_"^"),("^D^S^"[("^"_RAPTYNOW_"^")) QUIT RAPTYNOW
  1. ;there is a difference that matters. notify the user and set the
  1. ;procedure type back to its original value.
  1. NEW RATMP
  1. S RASTR=$$EXTERNAL^DILFD(71,6,"",OPTYP) ;the external value of original ptype
  1. S RATMP=$$EXTERNAL^DILFD(71,6,"",RAPTYNOW) ;the external value new ptype
  1. S RAMSG(1)="An update from a "_RASTR_" to a "_RATMP_" procedure type is not allowed."
  1. S RAMSG(1,"F")="!!?3",RAMSG(2)="",RAMSG(2,"F")="!"
  1. D EN^DDIOL(.RAMSG,"")
  1. N RAERR,RAFDA S RAFDA(71,RAPIEN_",",6)=OPTYP ;original ptype value restored.
  1. D FILE^DIE("","RAFDA","RAERR")
  1. S:$D(RAERR)#2 $P(^RAMIS(71,RAPIEN,0),U,6)=OPTYP ;hardset: no xrefs on nat'l DD
  1. Q OPTYP
  1. ;