Routine: RAIPS171

RAIPS171 ;WOIFO/KLM-PostInit 171; May 07, 2020@10:39:40

 ;;5.0;Radiology/Nuclear Medicine;**171**;Mar 16, 1998;Build 1

 ;This post-install routine will add/update the COVID cancel/hold reasons

 ;in the RAD/NUC MED REASON file (#75.2)

EN ;entry point

 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 - ? checks for existing record

 .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

 .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

REA     ;REASON;SYNONYM;TYPE OF REASON

 ;;COVID-19 CLINICAL REVIEW;COVID-19 CLIN REVIEW;3

 ;;COVID-19 CLINICAL REVIEW COMPLETE TO SCHEDULE;COVID-19: CLIN REV TO SCHED;3

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPS171   1063     printed  Mar 13, 2025@21:40:55                                                                                                                                                                                                    Page 2

RAIPS171  ;WOIFO/KLM-PostInit 171; May 07, 2020@10:39:40

 +1       ;;5.0;Radiology/Nuclear Medicine;**171**;Mar 16, 1998;Build 1

 +2       ;

 +3       ;This post-install routine will add/update the COVID cancel/hold reasons

 +4       ;in the RAD/NUC MED REASON file (#75.2)

EN        ;entry point

 +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 - ? checks for existing record

                   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

                   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       ;;COVID-19 CLINICAL REVIEW;COVID-19 CLIN REVIEW;3

 +2       ;;COVID-19 CLINICAL REVIEW COMPLETE TO SCHEDULE;COVID-19: CLIN REV TO SCHED;3

RAIPS171.m