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

DGQEP0.m

Go to the documentation of this file.
  1. DGQEP0 ;ALB/JFP - VIC PRE INIT UTILITES; 09/01/96
  1. ;;5.3;Registration;**73,1015**;DEC 11,1996;Build 21
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. TYPE ;-- Create entry in TERMINAL TYPE file (#3.2)
  1. ;
  1. ;Input : None
  1. ;Output : None
  1. ;Note : This is a KIDS complient check point
  1. ;
  1. ; -- Declare variables
  1. N DIC,X,Y,DLAYGO,DTOUT,DUOUT,NEWENTRY,MSGTXT,PTREVNT,DIE,DA,DR
  1. ; -- Create/find entry
  1. D BMES^XPDUTL(">>> Creating entry for P-VIC-OTHER in TERMINAL TYPE file (#3.2)")
  1. S DIC=3.2
  1. S DIC(0)="LX"
  1. S DLAYGO=3.2
  1. S X="P-VIC-OTHER"
  1. D ^DIC
  1. S PTREVNT=+Y
  1. S NEWENTRY=+$P(Y,"^",3)
  1. S MSGTXT(1)=" Existing entry found and updated"
  1. S:(NEWENTRY) MSGTXT(1)=" New entry created "
  1. I (PTREVNT<0) D Q
  1. .S MSGTXT(1)=" ** Unable to create entry for P-VIC-OTHER"
  1. .S MSGTXT(2)=" ** Entry must be created manually"
  1. .D MES^XPDUTL(.MSGTXT)
  1. .K MSGTXT
  1. ;
  1. ; -- update remaining fields
  1. S DIE=3.2,DA=+Y
  1. S DR=".02///1;1///0;2///#;3///66;4///$C(8)"
  1. D ^DIE
  1. ; -- Display message
  1. D MES^XPDUTL(.MSGTXT)
  1. ;Done
  1. Q
  1. ;
  1. DEVICE ; -- Create entry in DEVICE file (#3.5)
  1. ;
  1. ;Input : $I device - Pre init question 2
  1. ; : Location of terminal - Pre init question 1
  1. ;Output : None
  1. ;Note : This is a KIDS complient check point
  1. ;
  1. ; -- Declare variables
  1. N DIC,X,Y,DLAYGO,DTOUT,DUOUT,NEWENTRY,MSGTXT,PTREVNT,DIE,DA,DR
  1. N DGQEI,DGQELOC
  1. ; -- Create/find entry
  1. D BMES^XPDUTL(">>> Creating entry for VIC CARD in DEVICE file (#3.5)")
  1. ; -- Check for existance of input
  1. I '$D(XPDQUES("PRE1","B")) S DGQELOC=""
  1. I '$D(XPDQUES("PRE2","B")) S DGQEI=""
  1. S DGQELOC=$G(XPDQUES("PRE1","B"))
  1. S DGQEI=$G(XPDQUES("PRE2","B"))
  1. S DIC=3.5
  1. S DIC("DR")="1///"_DGQEI
  1. S DIC(0)="LX"
  1. S DLAYGO=3.5
  1. S X="VIC CARD"
  1. D ^DIC
  1. I $D(DTOUT) D Q
  1. .S MSGTXT(1)=" ** Unable to create entry for VIC CARD"
  1. .S MSGTXT(2)=" ** Time out expired"
  1. .S MSGTXT(3)=" ** Entry must be created manually"
  1. .D MES^XPDUTL(.MSGTXT)
  1. .K MSGTXT
  1. S PTREVNT=+Y
  1. S NEWENTRY=+$P(Y,"^",3)
  1. S MSGTXT(1)=" Existing entry found and updated"
  1. S:(NEWENTRY) MSGTXT(1)=" New entry created "
  1. I (PTREVNT<0) D Q
  1. .S MSGTXT(1)=" ** Unable to create entry for VIC CARD"
  1. .S MSGTXT(2)=" ** Entry must be created manually"
  1. .D MES^XPDUTL(.MSGTXT)
  1. .K MSGTXT
  1. ;
  1. ; -- update remaining fields
  1. S DIE=3.5,DA=+Y
  1. S DR="1///"_DGQEI_";.02///"_DGQELOC_";1.95///0;2///OTH;3///P-VIC-OTHER;9///132;10///#;11///66;11.2///1;12///$C(8);51.2///3;51.3///900;51.5///0;63///N"
  1. D ^DIE
  1. ; -- Display message
  1. I DGQELOC="" S MSGTXT(1)=" ",MSGTXT(2)=" Location entered as null, this will need manual update"
  1. I DGQEI="" D
  1. .S MSGTXT(3)=" "
  1. .S MSGTXT(4)="** $I is a critical element and it has been entered as null"
  1. .S MSGTXT(5)=" This will need to manually updated for VIC to function properly"
  1. D MES^XPDUTL(.MSGTXT)
  1. ;Done
  1. Q
  1. ;