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

XT142P.m

Go to the documentation of this file.
  1. XT142P ;OIFO-BP/BT - parameters ENTITY file ; 03/06/2019
  1. ;;7.3;TOOLKIT;**142**;Apr 25, 1995;Build 10
  1. ;Per VHA Directive 6402, this routine should not be modified
  1. Q
  1. ;-------------------------------------------------
  1. ADD ;
  1. N ABORT,ARER,ARERR,DA,DIC,DIR,DIE,DR,FDA,FDAIEN,HD,IEN,Y
  1. S HD="The Following Data Have Been Added To File #8989.518"
  1. S (ABORT,IEN)=0
  1. S FDA(8989.518,"?+1,",.01)="CLINIC STOP"
  1. S FDA(8989.518,"?+1,",.02)="CST"
  1. S FDA(8989.518,"?+1,",.03)="Clinic Stop"
  1. I $D(^XTV(8989.518,40.7,0))'=1 D
  1. . S FDAIEN(1)="40.7"
  1. . D UPDATE^DIE(,"FDA","FDAIEN","ARER")
  1. E D
  1. . D UPDATE^DIE(,"FDA",,"ARER")
  1. I $D(ARER) D Q:ABORT
  1. . S ABORT=1
  1. . D BMES^XPDUTL($C(7))
  1. . D BMES^XPDUTL("")
  1. . D BMES^XPDUTL("An ERROR has occured")
  1. . D BMES^XPDUTL($P(ARER("DIERR",1),"^")," - ")
  1. . D BMES^XPDUTL($P(ARER("DIERR",1,"TEXT",1),"^"))
  1. S IEN=$$FIND1^DIC(8989.518,,,"CLINIC STOP",,,"ARERR")
  1. I IEN D Q:ABORT
  1. . D BMES^XPDUTL("")
  1. . D MES^XPDUTL(HD)
  1. . D MES^XPDUTL($$REPEAT^XLFSTR("=",$L(HD)))
  1. . D MES^XPDUTL($$GET1^DIQ(8989.518,IEN,.01,"E"))
  1. . D MES^XPDUTL($$GET1^DIQ(8989.518,IEN,.02,"E"))
  1. . D MES^XPDUTL($$GET1^DIQ(8989.518,IEN,.03,"E"))
  1. . D MES^XPDUTL("")
  1. . S ABORT=1
  1. Q
  1. ;
  1. POST ;
  1. D ADD
  1. Q