Routine: RAIPS191

RAIPS191 ;WOIFO/KLM - PostInit 191 ; Jun 02, 2022@06:46:05

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

 ; This post-install routine will add a Contrast Shortage cancel/hold reason

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

 ; Reference to UPDATE^DIE in ICR #2053

 ; Reference to MES^XPDUTL in ICR #10141

EN ;entry point

 N RAI,RAREA,RAMSG,RATXT,RAMSG,RA01,RA2,RA3

 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

 ;;GLOBAL CONTRAST SHORTAGE;SHORTAGE;9

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPS191   1094     printed  Mar 13, 2025@21:41:01                                                                                                                                                                                                    Page 2

RAIPS191  ;WOIFO/KLM - PostInit 191 ; Jun 02, 2022@06:46:05

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

 +2       ;

 +3       ; This post-install routine will add a Contrast Shortage cancel/hold reason

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

 +5       ;

 +6       ; Reference to UPDATE^DIE in ICR #2053

 +7       ; Reference to MES^XPDUTL in ICR #10141

 +8       ;

EN        ;entry point

 +1        NEW RAI,RAREA,RAMSG,RATXT,RAMSG,RA01,RA2,RA3

 +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       ;;GLOBAL CONTRAST SHORTAGE;SHORTAGE;9

RAIPS191.m