Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRC5167P

PRC5167P.m

Go to the documentation of this file.
  1. PRC5167P ;OI&T/DDA - INSTALL UTILITY ROUTINE ;7/2/12 13:58
  1. ;;5.1;IFCAP;**167**;Oct 20, 2000;Build 17
  1. ;;Per VHA Directive 2004-38, this routine should not be modified.
  1. ;
  1. Q
  1. POST ; post install;
  1. ; ADD the two new eCMS related status entries
  1. N PRCERR,PRCD4423
  1. S PRCERR=""
  1. S PRCD4423=1
  1. S PRCIEN(1)=69
  1. S PRC4423(442.3,"+1,",.01)="Sent to eCMS (P&C)"
  1. S PRC4423(442.3,"+1,",.02)=69
  1. D UPDATE^DIE("","PRC4423","PRCIEN","PRCERR")
  1. ;I $D(PRCERR)
  1. K PRC4423,PRCIEN
  1. S PRCIEN(1)=77
  1. S PRC4423(442.3,"+1,",.01)="Returned to Service by eCMS (P&C)"
  1. S PRC4423(442.3,"+1,",.02)=77
  1. D UPDATE^DIE("","PRC4423","PRCIEN","PRCERR")
  1. K PRC4423,PRCIEN
  1. UPDT ; Update status 70 to new text
  1. S PRC4423(442.3,"70,",.01)="To IFCAP Ordering Officer"
  1. D FILE^DIE("","PRC4423","PRCERR")
  1. K PRC4423
  1. ;
  1. ID ; covered by ICR #5819
  1. D MES^XPDUTL(" - Setting ID nodes for file #410 and subfile #410.02")
  1. S ^DD(410,0,"ID","Z3")="D:$P($G(^(1)),U,8)]"""" EN^DDIOL(""Sent to eCMS"",,""?0""),EN^DDIOL("" "",,""!?2"")"
  1. S ^DD(410.02,0,"ID","Z2")="D:$P($G(@(DIC_+Y_"",4)"")),U,3)]"""" EN^DDIOL(""eCMS Item Line ID ""_$P(^(4),U,3),,""!?10"")"
  1. D MES^XPDUTL(" - ID nodes set")
  1. ;
  1. Q