RAIPS163 ;WOIFO/KLM-Rad/NM Post-init Driver, patch 163; Oct 10, 2019@09:30:04
;;5.0;Radiology/Nuclear Medicine;**163**;Mar 16, 1998;Build 1
;New standardized Cancel/Hold reasons
;
EN ;Entry pt for post-install
N RAI,RAREA,RAMSG
F RAI=1:1 S RAREA=$T(REA+RAI) Q:RAREA="" D
.S RA01=$P(RAREA,";",3),RA3=$P(RAREA,";",4),RA2=$P(RAREA,";",5)
.N RAFDA,RAR S RAR="RAFDA(75.2,""?+1,"")" ;FDA root -Check for existing entry
.S @RAR@(.01)=RA01 ;Reason
.S @RAR@(2)=RA2 ;Type of reason (1=cancel,3=hold,9=general)
.S @RAR@(3)=RA3 ;Synonym
.S @RAR@(4)="i" ;Nature of order activity=Policy
.S @RAR@(5)="Y" ;NATIONAL flag = YES prevents local modifications
.D UPDATE^DIE(,"RAFDA","","RAMSG(1)") K RAFDA
.I $D(RAMSG(1,"DIERR"))#2 S RATXT="An error occured filing data for "_RA01
.E S RATXT=RA01_" filed"
.D MES^XPDUTL(RATXT) K RATXT,RAMSG
Q
REA ;REASON;SYNONYM;TYPE OF REASON
;;PATIENT DECEASED;DECEASED;1
;;REQUESTING PHYSICIAN CANCELLED;REQ MD CX'D;1
;;CONTRAINDICATION;CONTRAINDICATED;1
;;PATIENT DECLINED TO SCHEDULE;DECLINED TO SCHED;1
;;INCORRECT PATIENT CONTACT INFORMATION;INCORRECT CONTACT;1
;;CANCELLED BY PATIENT;CX'D BY PT;1
;;INCLEMENT WEATHER;WEATHER;3
;;NEEDS TO CONSULT WITH PROVIDER;CONSULT W/PROVIDER;3
;;CANCELLED BY CLINIC;CX'D BY CLIN;3
;;OTHER;OTHER;9
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPS163 1337 printed Dec 13, 2024@02:36:06 Page 2
RAIPS163 ;WOIFO/KLM-Rad/NM Post-init Driver, patch 163; Oct 10, 2019@09:30:04
+1 ;;5.0;Radiology/Nuclear Medicine;**163**;Mar 16, 1998;Build 1
+2 ;New standardized Cancel/Hold reasons
+3 ;
EN ;Entry pt for post-install
+1 NEW RAI,RAREA,RAMSG
+2 FOR RAI=1:1
SET RAREA=$TEXT(REA+RAI)
if RAREA=""
QUIT
Begin DoDot:1
+3 SET RA01=$PIECE(RAREA,";",3)
SET RA3=$PIECE(RAREA,";",4)
SET RA2=$PIECE(RAREA,";",5)
+4 ;FDA root -Check for existing entry
NEW RAFDA,RAR
SET RAR="RAFDA(75.2,""?+1,"")"
+5 ;Reason
SET @RAR@(.01)=RA01
+6 ;Type of reason (1=cancel,3=hold,9=general)
SET @RAR@(2)=RA2
+7 ;Synonym
SET @RAR@(3)=RA3
+8 ;Nature of order activity=Policy
SET @RAR@(4)="i"
+9 ;NATIONAL flag = YES prevents local modifications
SET @RAR@(5)="Y"
+10 DO UPDATE^DIE(,"RAFDA","","RAMSG(1)")
KILL RAFDA
+11 IF $DATA(RAMSG(1,"DIERR"))#2
SET RATXT="An error occured filing data for "_RA01
+12 IF '$TEST
SET RATXT=RA01_" filed"
+13 DO MES^XPDUTL(RATXT)
KILL RATXT,RAMSG
End DoDot:1
+14 QUIT
REA ;REASON;SYNONYM;TYPE OF REASON
+1 ;;PATIENT DECEASED;DECEASED;1
+2 ;;REQUESTING PHYSICIAN CANCELLED;REQ MD CX'D;1
+3 ;;CONTRAINDICATION;CONTRAINDICATED;1
+4 ;;PATIENT DECLINED TO SCHEDULE;DECLINED TO SCHED;1
+5 ;;INCORRECT PATIENT CONTACT INFORMATION;INCORRECT CONTACT;1
+6 ;;CANCELLED BY PATIENT;CX'D BY PT;1
+7 ;;INCLEMENT WEATHER;WEATHER;3
+8 ;;NEEDS TO CONSULT WITH PROVIDER;CONSULT W/PROVIDER;3
+9 ;;CANCELLED BY CLINIC;CX'D BY CLIN;3
+10 ;;OTHER;OTHER;9
