source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG53P425.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1DG53P425 ;ALB/RPM - PATCH DG*5.3*425 INSTALL UTILITIES ; 8/21/03 4:52pm
2 ;;5.3;Registration;**425**;Aug 13, 1993
3 ;
4ENV ;Main entry point for Environment check point.
5 ;
6 S XPDABORT=""
7 D PROGCHK(.XPDABORT) ;checks programmer variables
8 I XPDABORT="" K XPDABORT
9 Q
10 ;
11 ;
12PRE ;Main entry point for Pre-init items.
13 ;
14 Q
15 ;
16 ;
17POST ;Main entry point for Post-init items.
18 ;
19 N DGACTDT ;software activation date
20 ;
21 S DGACTDT="Sep 25, 2003" ;National PRF Software Activation date
22 ;
23 D POST1(DGACTDT) ;create/update PRF PARAMETERS (#26.18) file
24 D POST2 ;load BEHAVIORAL Category I PRF
25 Q
26 ;
27 ;
28PROGCHK(XPDABORT) ;checks for necessary programmer variables
29 ;
30 I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") DO
31 .D BMES^XPDUTL("*****")
32 .D MES^XPDUTL("Your programming variables are not set up properly.")
33 .D MES^XPDUTL("Installation aborted.")
34 .D MES^XPDUTL("*****")
35 .S XPDABORT=2
36 Q
37 ;
38POST1(DGACTDT) ;create PRF PARAMETERS (#26.18) file entry at IEN "1"
39 ;
40 ; Input:
41 ; DGACTDT - (optional) software activation date in external format
42 ; [default="May 01, 2003" ;used at test sites]
43 ;
44 ; Output:
45 ; none
46 ;
47 N DGACT ;type of file activity (add/update)
48 N DGFDA ;FDA array
49 N DGFLD ;field #
50 N DGERR ;error array
51 N DGIEN ;IEN array
52 N DGIENS
53 N DGPARM ;parameter record
54 ;
55 I $G(DGACTDT)="" S DGACTDT="May 01, 2003" ;date for test sites
56 ;
57 ;existing file entry
58 I $D(^DGPF(26.18,1,0))#2 D
59 . N DGERR
60 . S DGIENS="1,"
61 . S DGACT="update"
62 E D
63 . S DGIENS="+1,"
64 . S DGACT="add"
65 ;
66 ;retrieve existing record
67 S DGPARM=$G(^DGPF(26.18,1,0))
68 ;
69 ;provide values for any missing parameters
70 I $P(DGPARM,U,1)="" S DGFDA(26.18,DGIENS,.01)=1
71 I $P(DGPARM,U,2)="" S DGFDA(26.18,DGIENS,1)=DGACTDT ;activation date
72 I $P(DGPARM,U,3)="" S DGFDA(26.18,DGIENS,2)="ACTIVE" ;ORU HL7 interface
73 I $P(DGPARM,U,4)="" S DGFDA(26.18,DGIENS,3)="DIRECT" ;QRY HL7 interface
74 I $P(DGPARM,U,6)="" S DGFDA(26.18,DGIENS,5)=7 ;HL7 Auto Retrans Days
75 ;
76 ;short-circuit when there are no missing parameters
77 I '$D(DGFDA) D Q
78 . D BMES^XPDUTL("*****")
79 . D MES^XPDUTL(" PRF PARAMETERS (#26.18) file values previously defined...no action taken.")
80 . D MES^XPDUTL("*****")
81 Q:'$D(DGFDA)
82 D UPDATE^DIE("ES","DGFDA","DGIEN","DGERR")
83 ;
84 ;check for errors and inform the installer of update status
85 I '$D(DGERR) D
86 . D BMES^XPDUTL("*****")
87 . D MES^XPDUTL("The '1' entry in the PRF PARAMETERS (#26.18) file was "_DGACT_$S(DGACT="add":"ed",1:"d")_" successfully.")
88 . ;
89 . ;display updated field list and values
90 . I DGACT="update" D
91 . . S DGFLD=0
92 . . F S DGFLD=$O(DGFDA(26.18,DGIENS,DGFLD)) Q:'DGFLD D
93 . . . D MES^XPDUTL("The "_$$GET1^DID(26.18,DGFLD,"","LABEL")_" (#"_DGFLD_") field was set to '"_DGFDA(26.18,DGIENS,DGFLD)_"'.")
94 . D MES^XPDUTL("*****")
95 E D
96 . D BMES^XPDUTL("*****")
97 . D MES^XPDUTL("The attempt to "_DGACT_" the '1' entry in the PRF PARAMETERS (#26.18) file failed.")
98 . D MES^XPDUTL($G(DGERR("DIERR",1,"TEXT",1)))
99 . D MES^XPDUTL("*****")
100 ;
101 Q
102 ;
103POST2 ;create BEHAVIORAL Category I PRF
104 ;
105 ;short circuit if flag already exists
106 I $D(^DGPF(26.15,"B","BEHAVIORAL")) D Q
107 . D BMES^XPDUTL("*****")
108 . D MES^XPDUTL(" 'BEHAVIORAL' Category I flag previously defined...no action taken.")
109 . D MES^XPDUTL("*****")
110 ;
111 N DGDESC ;description word-processing array
112 N DGFDA ;FDA array
113 N DGIEN ;IEN array
114 ;
115 ;flag description
116 S DGDESC(1,0)="The purpose of this National Patient Record Flag is to alert VHA medical"
117 S DGDESC(2,0)="staff and employees of patients whose behavior or characteristics may pose"
118 S DGDESC(3,0)="a threat either to their safety, the safety of other patients, or"
119 S DGDESC(4,0)="compromise the delivery of quality health care."
120 S DGDESC(5,0)="Application of National Patient Record Flags is coordinated through the"
121 S DGDESC(6,0)="Chief of Staff."
122 S DGDESC(7,0)="This is a nationally distributed flag."
123 ;
124 ;build FDA array
125 S DGFDA(26.15,"+1,",.01)="BEHAVIORAL"
126 S DGFDA(26.15,"+1,",.02)="ACTIVE"
127 S DGFDA(26.15,"+1,",.03)="BEHAVIORAL"
128 S DGFDA(26.15,"+1,",.04)=730
129 S DGFDA(26.15,"+1,",.05)=60
130 S DGFDA(26.15,"+1,",.06)="DGPF BEHAVIORAL FLAG REVIEW"
131 S DGFDA(26.15,"+1,",1)="DGDESC"
132 ;
133 ;ask for IEN = 1
134 S DGIEN(1)=1
135 ;
136 ;store record
137 D UPDATE^DIE("E","DGFDA","DGIEN","DGERR")
138 ;
139 ;check for errors and inform the installer of update status
140 D BMES^XPDUTL("*****")
141 I $D(^DGPF(26.15,"B","BEHAVIORAL")),'$D(DGERR) D
142 . D MES^XPDUTL(" 'BEHAVIORAL' Category I Patient Record Flag created successfully.")
143 E D
144 . D MES^XPDUTL(" 'BEHAVIORAL' Category I Patient Record Flag creation failed!")
145 D MES^XPDUTL("*****")
146 Q
Note: See TracBrowser for help on using the repository browser.