source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGQEP0.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1DGQEP0 ;ALB/JFP - VIC PRE INIT UTILITES; 09/01/96
2 ;;V5.3;REGISTRATION;**73**;DEC 11,1996
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5TYPE ;-- Create entry in TERMINAL TYPE file (#3.2)
6 ;
7 ;Input : None
8 ;Output : None
9 ;Note : This is a KIDS complient check point
10 ;
11 ; -- Declare variables
12 N DIC,X,Y,DLAYGO,DTOUT,DUOUT,NEWENTRY,MSGTXT,PTREVNT,DIE,DA,DR
13 ; -- Create/find entry
14 D BMES^XPDUTL(">>> Creating entry for P-VIC-OTHER in TERMINAL TYPE file (#3.2)")
15 S DIC=3.2
16 S DIC(0)="LX"
17 S DLAYGO=3.2
18 S X="P-VIC-OTHER"
19 D ^DIC
20 S PTREVNT=+Y
21 S NEWENTRY=+$P(Y,"^",3)
22 S MSGTXT(1)=" Existing entry found and updated"
23 S:(NEWENTRY) MSGTXT(1)=" New entry created "
24 I (PTREVNT<0) D Q
25 .S MSGTXT(1)=" ** Unable to create entry for P-VIC-OTHER"
26 .S MSGTXT(2)=" ** Entry must be created manually"
27 .D MES^XPDUTL(.MSGTXT)
28 .K MSGTXT
29 ;
30 ; -- update remaining fields
31 S DIE=3.2,DA=+Y
32 S DR=".02///1;1///0;2///#;3///66;4///$C(8)"
33 D ^DIE
34 ; -- Display message
35 D MES^XPDUTL(.MSGTXT)
36 ;Done
37 Q
38 ;
39DEVICE ; -- Create entry in DEVICE file (#3.5)
40 ;
41 ;Input : $I device - Pre init question 2
42 ; : Location of terminal - Pre init question 1
43 ;Output : None
44 ;Note : This is a KIDS complient check point
45 ;
46 ; -- Declare variables
47 N DIC,X,Y,DLAYGO,DTOUT,DUOUT,NEWENTRY,MSGTXT,PTREVNT,DIE,DA,DR
48 N DGQEI,DGQELOC
49 ; -- Create/find entry
50 D BMES^XPDUTL(">>> Creating entry for VIC CARD in DEVICE file (#3.5)")
51 ; -- Check for existance of input
52 I '$D(XPDQUES("PRE1","B")) S DGQELOC=""
53 I '$D(XPDQUES("PRE2","B")) S DGQEI=""
54 S DGQELOC=$G(XPDQUES("PRE1","B"))
55 S DGQEI=$G(XPDQUES("PRE2","B"))
56 S DIC=3.5
57 S DIC("DR")="1///"_DGQEI
58 S DIC(0)="LX"
59 S DLAYGO=3.5
60 S X="VIC CARD"
61 D ^DIC
62 I $D(DTOUT) D Q
63 .S MSGTXT(1)=" ** Unable to create entry for VIC CARD"
64 .S MSGTXT(2)=" ** Time out expired"
65 .S MSGTXT(3)=" ** Entry must be created manually"
66 .D MES^XPDUTL(.MSGTXT)
67 .K MSGTXT
68 S PTREVNT=+Y
69 S NEWENTRY=+$P(Y,"^",3)
70 S MSGTXT(1)=" Existing entry found and updated"
71 S:(NEWENTRY) MSGTXT(1)=" New entry created "
72 I (PTREVNT<0) D Q
73 .S MSGTXT(1)=" ** Unable to create entry for VIC CARD"
74 .S MSGTXT(2)=" ** Entry must be created manually"
75 .D MES^XPDUTL(.MSGTXT)
76 .K MSGTXT
77 ;
78 ; -- update remaining fields
79 S DIE=3.5,DA=+Y
80 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"
81 D ^DIE
82 ; -- Display message
83 I DGQELOC="" S MSGTXT(1)=" ",MSGTXT(2)=" Location entered as null, this will need manual update"
84 I DGQEI="" D
85 .S MSGTXT(3)=" "
86 .S MSGTXT(4)="** $I is a critical element and it has been entered as null"
87 .S MSGTXT(5)=" This will need to manually updated for VIC to function properly"
88 D MES^XPDUTL(.MSGTXT)
89 ;Done
90 Q
91 ;
Note: See TracBrowser for help on using the repository browser.