Routine: PRC51158

PRC51158 ;SSOI&TFO/LKG - POST-INIT PRC*5.1*158 ;6/30/11  16:00

V ;;5.1;IFCAP;**158**;Oct 20, 2000;Build 1

 ;;Per VHA Directive 2004-038, this routine should not be modified.

POST ;Beginning of post-init logic

 ;Renaming PAT TYPE entry with IEN of 21 from 'MISC. OBLIGATION (1358)'

 ; to '1358 OBLIGATION'.

 N PRCARR,PRCERR,PRCMSG,PRCI

 S PRCARR(442.5,"21,",.01)="1358 OBLIGATION"

 D FILE^DIE("EK","PRCARR","PRCERR")

 I $D(PRCERR("DIERR")) D

 . D BMES^XPDUTL("PAT TYPE entry with IEN 21 was not renamed to '1358 OBLIGATION'.")

 . S PRCI=0

 . F  S PRCI=$O(PRCERR("DIERR",1,"TEXT",PRCI)) Q:PRCI'>0  S PRCMSG(PRCI)=PRCERR("DIERR",1,"TEXT",PRCI)

 . D:$D(PRCMSG) MES^XPDUTL(.PRCMSG)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRC51158   699     printed  Mar 13, 2025@21:04:29                                                                                                                                                                                                     Page 2

PRC51158  ;SSOI&TFO/LKG - POST-INIT PRC*5.1*158 ;6/30/11  16:00

V         ;;5.1;IFCAP;**158**;Oct 20, 2000;Build 1

 +1       ;;Per VHA Directive 2004-038, this routine should not be modified.

 +2        QUIT

POST      ;Beginning of post-init logic

 +1       ;Renaming PAT TYPE entry with IEN of 21 from 'MISC. OBLIGATION (1358)'

 +2       ; to '1358 OBLIGATION'.

 +3        NEW PRCARR,PRCERR,PRCMSG,PRCI

 +4        SET PRCARR(442.5,"21,",.01)="1358 OBLIGATION"

 +5        DO FILE^DIE("EK","PRCARR","PRCERR")

 +6        IF $DATA(PRCERR("DIERR"))

               Begin DoDot:1

 +7                DO BMES^XPDUTL("PAT TYPE entry with IEN 21 was not renamed to '1358 OBLIGATION'.")

 +8                SET PRCI=0

 +9                FOR

                       SET PRCI=$ORDER(PRCERR("DIERR",1,"TEXT",PRCI))

                       if PRCI'>0

                           QUIT

                       SET PRCMSG(PRCI)=PRCERR("DIERR",1,"TEXT",PRCI)

 +10               if $DATA(PRCMSG)

                       DO MES^XPDUTL(.PRCMSG)

               End DoDot:1

 +11       QUIT

PRC51158.m