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