RAI133PO ;WOIFO/KLM-Rad/NM Post-init Driver, patch 133;11/03/16
;;5.0;Radiology/Nuclear Medicine;**133**;November 3, 2016;Build 4
;New standardized reasons to be used for updating
;requests in a HOLD status. Standardized reasons
;provided here will not be editable by the site.
;
EN ;Entry pt for post-install
N RACHK
;
;Load new reasons file 75.2
S RACHK=$$NEWCP^XPDUTL("POST1","EN1^RAI133PO")
;
;Check Rad/Nuc Med Divisions for request/exam status tracking
S RACHK=$$NEWCP^XPDUTL("POST2","EN2^RAI133PO")
Q
EN1 ;Load national entries into RAD/NUC MED REASON file #75.2
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)
.N RAFDA,RAR S RAR="RAFDA(75.2,""?+1,"")" ;FDA root -Check for existing entry
.S @RAR@(.01)=RA01 ;Reason
.S @RAR@(2)=3 ;Type of reason=hold request
.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
EN2 ;Check all divisions to be sure Request / Exam Status Tracking is enabled
N RADIV,RAFDA,RACHK
S RADIV="" F S RADIV=$O(^RA(79,"B",RADIV)) Q:'RADIV D
.I $P($G(^RA(79,RADIV,.1)),"^",19)'="y"!($P($G(^RA(79,RADIV,.1)),"^",10)'="Y") D
..S RAFDA(79,RADIV_",",.119)="y"
..S RAFDA(79,RADIV_",",.11)="Y"
..D FILE^DIE("","RAFDA","RAMSG(1)") K RAFDA
..I $D(RAMSG(1,"DIERR"))#2 S RATXT="Problem updating Rad/Nuc Med Division data"
..E S RATXT="Rad/Nuc Med Divisions updated"
..S RACHK=$$UPCP^XPDUTL("POST2",RADIV)
I '$D(RATXT) S RATXT="No Rad/Nuc Med Divisions updates needed"
D BMES^XPDUTL(RATXT) K RATXT,RAMSG
Q
REA ;REASON;SYNONYM
;;CALLED VETERAN FOR APPT;CALL
;;MYHEALTHYVET CONTACT;MHV
;;LETTER SENT TO CALL VA;LETTER
;;RESCHED CALL BY VETERAN;RESCHED
;;MRI SAFETY REVIEW;MRISAFETY
;;RADIOLOGIST REVIEW;RADREV
;;COMMUNITY CARE APPT;COMCARE
;;WAITING ON OUTSIDE IMAGES;OUTIMAGE
;;FUTURE APPOINTMENT;FUTUREAPT
;;NON RADIOLOGY CONSULT;NONRADCON
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAI133PO 2227 printed Dec 13, 2024@02:35:43 Page 2
RAI133PO ;WOIFO/KLM-Rad/NM Post-init Driver, patch 133;11/03/16
+1 ;;5.0;Radiology/Nuclear Medicine;**133**;November 3, 2016;Build 4
+2 ;New standardized reasons to be used for updating
+3 ;requests in a HOLD status. Standardized reasons
+4 ;provided here will not be editable by the site.
+5 ;
EN ;Entry pt for post-install
+1 NEW RACHK
+2 ;
+3 ;Load new reasons file 75.2
+4 SET RACHK=$$NEWCP^XPDUTL("POST1","EN1^RAI133PO")
+5 ;
+6 ;Check Rad/Nuc Med Divisions for request/exam status tracking
+7 SET RACHK=$$NEWCP^XPDUTL("POST2","EN2^RAI133PO")
+8 QUIT
EN1 ;Load national entries into RAD/NUC MED REASON file #75.2
+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)
+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=hold request
SET @RAR@(2)=3
+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
EN2 ;Check all divisions to be sure Request / Exam Status Tracking is enabled
+1 NEW RADIV,RAFDA,RACHK
+2 SET RADIV=""
FOR
SET RADIV=$ORDER(^RA(79,"B",RADIV))
if 'RADIV
QUIT
Begin DoDot:1
+3 IF $PIECE($GET(^RA(79,RADIV,.1)),"^",19)'="y"!($PIECE($GET(^RA(79,RADIV,.1)),"^",10)'="Y")
Begin DoDot:2
+4 SET RAFDA(79,RADIV_",",.119)="y"
+5 SET RAFDA(79,RADIV_",",.11)="Y"
+6 DO FILE^DIE("","RAFDA","RAMSG(1)")
KILL RAFDA
+7 IF $DATA(RAMSG(1,"DIERR"))#2
SET RATXT="Problem updating Rad/Nuc Med Division data"
+8 IF '$TEST
SET RATXT="Rad/Nuc Med Divisions updated"
+9 SET RACHK=$$UPCP^XPDUTL("POST2",RADIV)
End DoDot:2
End DoDot:1
+10 IF '$DATA(RATXT)
SET RATXT="No Rad/Nuc Med Divisions updates needed"
+11 DO BMES^XPDUTL(RATXT)
KILL RATXT,RAMSG
+12 QUIT
REA ;REASON;SYNONYM
+1 ;;CALLED VETERAN FOR APPT;CALL
+2 ;;MYHEALTHYVET CONTACT;MHV
+3 ;;LETTER SENT TO CALL VA;LETTER
+4 ;;RESCHED CALL BY VETERAN;RESCHED
+5 ;;MRI SAFETY REVIEW;MRISAFETY
+6 ;;RADIOLOGIST REVIEW;RADREV
+7 ;;COMMUNITY CARE APPT;COMCARE
+8 ;;WAITING ON OUTSIDE IMAGES;OUTIMAGE
+9 ;;FUTURE APPOINTMENT;FUTUREAPT
+10 ;;NON RADIOLOGY CONSULT;NONRADCON
