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

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

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1DG53P554 ;ALB/RBS - PATCH DG*5.3*554 INSTALL UTILITIES ; 3/16/06 2:55pm
2 ;;5.3;Registration;**554**;Aug 13, 1993
3 ;
4ENV ;Main entry point for Environment check point.
5 ;
6 S XPDABORT=""
7 D PROGCHK(.XPDABORT) ;checks programmer variables
8 Q:$G(XPDABORT)
9 ;
10 I XPDABORT="" K XPDABORT
11 ;
12 ;Per KIDS documentation...XPDQUIT is used for multiple builds
13 S XPDQUIT=""
14 D TIUCHK(.XPDQUIT) ;check for TIU Progress Note Title
15 Q:$G(XPDQUIT)
16 ;
17 I XPDQUIT="" K XPDQUIT
18 Q
19 ;
20 ;
21PRE ;Main entry point for Pre-init items.
22 ;
23 Q
24 ;
25 ;
26POST ;Main entry point for Post-init items.
27 ;
28 N DGACTDT ;software activation date
29 ;
30 D POST1 ;link BEHAVIORAL Category I PRF to TIU PN
31 ;
32 D POST2 ;create new "C" index for Principal Investigator field
33 ; in the PRF Local Flag (#26.11) file.
34 ;
35 S DGACTDT="June 20, 2006" ;PRF Phase 2 Software Activation date
36 ;
37 D POST3(DGACTDT) ;create/update PRF PHASE 2 ACTIVATION (#6) field
38 ; in the PRF PARAMETERS (#26.18) file.
39 Q
40 ;
41 ;
42PROGCHK(XPDABORT) ;checks for necessary programmer variables
43 ;
44 I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") DO
45 .D BMES^XPDUTL("*****")
46 .D MES^XPDUTL("Your programming variables are not set up properly.")
47 .D MES^XPDUTL("Installation aborted.")
48 .D MES^XPDUTL("*****")
49 .S XPDABORT=2
50 Q
51 ;
52 ;
53TIUCHK(XPDQUIT) ;check for Category I (National) TIU Progress Note Title
54 ;name setup in the TIU DOCUMENT DEFINITION file (#8925.1)
55 ;Abort if not found.
56 ;
57 N DGTITLE
58 S DGTITLE="PATIENT RECORD FLAG CATEGORY I"
59 ;
60 I '$$FIND1^DIC(8925.1,"","X",DGTITLE,"B") D
61 . D BMES^XPDUTL("*****")
62 . D MES^XPDUTL("The TIU Progress Note Title name 'PATIENT RECORD FLAG CATEGORY I' is not setup.")
63 . D MES^XPDUTL("See patch TIU*1*165 for details.")
64 . D MES^XPDUTL("Installation aborted.")
65 . D MES^XPDUTL("*****")
66 . S XPDQUIT=1
67 ;
68 Q
69 ;
70 ;
71POST1 ;link associated TIU PROGRESS NOTE TITLE IEN to
72 ;the Category I (National) PRF BEHAVIORAL Flag
73 ;
74 ;warn installer if flag not found
75 I '$D(^DGPF(26.15,"B","BEHAVIORAL")) D Q
76 . D BMES^XPDUTL("*****")
77 . D MES^XPDUTL(" 'BEHAVIORAL' Category I (National) PRF Flag not defined...seek help!")
78 . D MES^XPDUTL("*****")
79 ;
80 ;short circuit if flag TIU PN Title already exists
81 I $D(^DGPF(26.15,"ATIU")) D Q
82 . D BMES^XPDUTL("*****")
83 . D MES^XPDUTL(" 'BEHAVIORAL' Category I (National) PRF Flag already associated with a TIU Progress Note Title...No action taken.")
84 . D MES^XPDUTL("*****")
85 ;
86 N DGFLAG ;Category I (National) PRF name
87 N DGIEN ;IEN of National Flag record
88 N DGFDA ;filer FDA array
89 N DGIENS ;filer record IEN value
90 N DGERR ;filer error array
91 N DGTITLE ;Category I (National) TIU Progress Note Title name
92 ;
93 ;Category I (National) PRF flag IEN record value
94 S DGFLAG="BEHAVIORAL"
95 S DGIEN=$O(^DGPF(26.15,"B",DGFLAG,0))
96 S DGIENS=DGIEN_","
97 ;
98 ;set name equal to the nationaly released Category I Title that
99 ;is setup in the TIU DOCUMENT DEFINITION file (#8925.1)
100 S DGTITLE="PATIENT RECORD FLAG CATEGORY I"
101 ;
102 ;build FDA array
103 S DGFDA(26.15,DGIENS,.07)=DGTITLE
104 ;
105 ;file link in new field (#.07) TIU PN TITLE
106 D FILE^DIE("E","DGFDA","DGERR")
107 ;
108 ;check for errors and inform the installer of update status
109 D BMES^XPDUTL("*****")
110 I '$D(DGERR) D
111 . D MES^XPDUTL(" 'BEHAVIORAL' Category I (National) PRF Flag linked to associated TIU Progress Note Title successfully.")
112 E D
113 . D MES^XPDUTL(" 'BEHAVIORAL' Category I (National) PRF Flag link to associated TIU Progress Note Title failed!")
114 D MES^XPDUTL("*****")
115 Q
116 ;
117 ;
118POST2 ;create new 'C' index for Principal Investigator field (multiple)
119 ;-- PRF LOCAL FLAG (#26.11) file
120 ;-- SUB-FILE (2) PRINCIPAL INVESTIGATOR(S) (#26.112), field (.01)
121 ;
122 Q:$D(^DGPF(26.11,"C")) ;already setup
123 ;
124 N DA,DIC,DIK,DGIEN,X
125 ;
126 S DGIEN=0
127 F S DGIEN=$O(^DGPF(26.11,DGIEN)) Q:'DGIEN D
128 . K DA,DIC,DIK,X
129 . S DIK=$$ROOT^DILFD(26.112,","_DGIEN_",")
130 . S DIK(1)=".01^C"
131 . S DA(1)=DGIEN
132 . D ENALL^DIK
133 ;
134 Q
135 ;
136 ;
137POST3(DGACTDT) ;create/update PRF PHASE 2 ACTIVATION (#6) field of the
138 ;PRF PARAMETERS (#26.18) file entry at IEN "1"
139 ;
140 ; Input:
141 ; DGACTDT - (required) software activation date in external format
142 ;
143 ; Output:
144 ; none
145 ;
146 N DGERR ;error array
147 N DGFDA ;FDA array
148 N DGRESULT ;return var
149 ;
150 Q:($G(DGACTDT)="")
151 ;
152 ;existing file entry
153 Q:'$D(^DGPF(26.18,1,0))
154 ;
155 ;convert external date to internal FM date
156 D CHK^DIE(26.18,6,"",DGACTDT,.DGRESULT,"DGERR")
157 Q:$D(DGERR)
158 Q:'$G(DGRESULT)
159 ;
160 S DGACTDT=DGRESULT
161 ;
162 S DGFDA(26.18,"1,",6)=DGACTDT
163 ;
164 D FILE^DIE("","DGFDA","DGERR")
165 ;
166 Q
Note: See TracBrowser for help on using the repository browser.