XT142P ;OIFO-BP/BT - parameters ENTITY file ; 03/06/2019
;;7.3;TOOLKIT;**142**;Apr 25, 1995;Build 10
;Per VHA Directive 6402, this routine should not be modified
Q
;-------------------------------------------------
ADD ;
N ABORT,ARER,ARERR,DA,DIC,DIR,DIE,DR,FDA,FDAIEN,HD,IEN,Y
S HD="The Following Data Have Been Added To File #8989.518"
S (ABORT,IEN)=0
S FDA(8989.518,"?+1,",.01)="CLINIC STOP"
S FDA(8989.518,"?+1,",.02)="CST"
S FDA(8989.518,"?+1,",.03)="Clinic Stop"
I $D(^XTV(8989.518,40.7,0))'=1 D
. S FDAIEN(1)="40.7"
. D UPDATE^DIE(,"FDA","FDAIEN","ARER")
E D
. D UPDATE^DIE(,"FDA",,"ARER")
I $D(ARER) D Q:ABORT
. S ABORT=1
. D BMES^XPDUTL($C(7))
. D BMES^XPDUTL("")
. D BMES^XPDUTL("An ERROR has occured")
. D BMES^XPDUTL($P(ARER("DIERR",1),"^")," - ")
. D BMES^XPDUTL($P(ARER("DIERR",1,"TEXT",1),"^"))
S IEN=$$FIND1^DIC(8989.518,,,"CLINIC STOP",,,"ARERR")
I IEN D Q:ABORT
. D BMES^XPDUTL("")
. D MES^XPDUTL(HD)
. D MES^XPDUTL($$REPEAT^XLFSTR("=",$L(HD)))
. D MES^XPDUTL($$GET1^DIQ(8989.518,IEN,.01,"E"))
. D MES^XPDUTL($$GET1^DIQ(8989.518,IEN,.02,"E"))
. D MES^XPDUTL($$GET1^DIQ(8989.518,IEN,.03,"E"))
. D MES^XPDUTL("")
. S ABORT=1
Q
;
POST ;
D ADD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXT142P 1238 printed Dec 13, 2024@02:40:30 Page 2
XT142P ;OIFO-BP/BT - parameters ENTITY file ; 03/06/2019
+1 ;;7.3;TOOLKIT;**142**;Apr 25, 1995;Build 10
+2 ;Per VHA Directive 6402, this routine should not be modified
+3 QUIT
+4 ;-------------------------------------------------
ADD ;
+1 NEW ABORT,ARER,ARERR,DA,DIC,DIR,DIE,DR,FDA,FDAIEN,HD,IEN,Y
+2 SET HD="The Following Data Have Been Added To File #8989.518"
+3 SET (ABORT,IEN)=0
+4 SET FDA(8989.518,"?+1,",.01)="CLINIC STOP"
+5 SET FDA(8989.518,"?+1,",.02)="CST"
+6 SET FDA(8989.518,"?+1,",.03)="Clinic Stop"
+7 IF $DATA(^XTV(8989.518,40.7,0))'=1
Begin DoDot:1
+8 SET FDAIEN(1)="40.7"
+9 DO UPDATE^DIE(,"FDA","FDAIEN","ARER")
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 DO UPDATE^DIE(,"FDA",,"ARER")
End DoDot:1
+12 IF $DATA(ARER)
Begin DoDot:1
+13 SET ABORT=1
+14 DO BMES^XPDUTL($CHAR(7))
+15 DO BMES^XPDUTL("")
+16 DO BMES^XPDUTL("An ERROR has occured")
+17 DO BMES^XPDUTL($PIECE(ARER("DIERR",1),"^")," - ")
+18 DO BMES^XPDUTL($PIECE(ARER("DIERR",1,"TEXT",1),"^"))
End DoDot:1
if ABORT
QUIT
+19 SET IEN=$$FIND1^DIC(8989.518,,,"CLINIC STOP",,,"ARERR")
+20 IF IEN
Begin DoDot:1
+21 DO BMES^XPDUTL("")
+22 DO MES^XPDUTL(HD)
+23 DO MES^XPDUTL($$REPEAT^XLFSTR("=",$LENGTH(HD)))
+24 DO MES^XPDUTL($$GET1^DIQ(8989.518,IEN,.01,"E"))
+25 DO MES^XPDUTL($$GET1^DIQ(8989.518,IEN,.02,"E"))
+26 DO MES^XPDUTL($$GET1^DIQ(8989.518,IEN,.03,"E"))
+27 DO MES^XPDUTL("")
+28 SET ABORT=1
End DoDot:1
if ABORT
QUIT
+29 QUIT
+30 ;
POST ;
+1 DO ADD
+2 QUIT
