Routine: RAIPS201

RAIPS201 ;WOIFO/KLM - PostInit 201 ; Mar 22, 2023@07:27:44

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

 ; This post-install routine will add a Supply Chain cancel/hold reason

 ; in the RAD/NUC MED REASON file (#75.2) and disable (remove 'TYPE OF REASON')

 ; the Global Contrast Shortage reason.

 ; 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_$S(RA2=9:" filed",1:" updated")

 .D MES^XPDUTL(RATXT)  K RATXT,RAMSG

REA     ;REASON;SYNONYM;TYPE OF REASON

 ;;SUPPLY CHAIN;SUPPLY CHAIN;9

 ;;GLOBAL CONTRAST SHORTAGE;SHORTAGE;@

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPS201   1223     printed  Feb 19, 2025@00:02:36                                                                                                                                                                                                    Page 2

RAIPS201  ;WOIFO/KLM - PostInit 201 ; Mar 22, 2023@07:27:44

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

 +2       ;

 +3       ; This post-install routine will add a Supply Chain cancel/hold reason

 +4       ; in the RAD/NUC MED REASON file (#75.2) and disable (remove 'TYPE OF REASON')

 +5       ; the Global Contrast Shortage reason.

 +6       ;

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

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

 +9       ;

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_$SELECT(RA2=9:" filed",1:" updated")

 +13               DO MES^XPDUTL(RATXT)

                   KILL RATXT,RAMSG

               End DoDot:1

 +14       QUIT

REA       ;REASON;SYNONYM;TYPE OF REASON

 +1       ;;SUPPLY CHAIN;SUPPLY CHAIN;9

 +2       ;;GLOBAL CONTRAST SHORTAGE;SHORTAGE;@

RAIPS201.m