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.
Q
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)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRC51158 699 printed Nov 22, 2024@17:09:46 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
