source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SD53121.m

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

initial load of FOIAVistA 6/30/08 version

File size: 5.8 KB
Line 
1SD53121 ;ALB/JRP - PATCH 121 POST-INIT;18-APR-97
2 ;;5.3;Scheduling;**121**;Aug 13, 1993
3 ;
4POST ;Main entry point of post-init
5 D DELTRIG
6 D SEED
7 D ERRCODE
8 D MGCHK
9 Q
10 ;
11DELTRIG ;Delete obsolete triggers on the TRANSMISSION REQUIRED field (#.04)
12 ; of the TRANSMITTED OUTPATIENT ENCOUNTER file (#409.73)
13 ;
14 ;Declare variables
15 N NODE,XREFNUM,X,DIK,DA,XPDIDTOT
16 ;Print header
17 D BMES^XPDUTL(">>> Deleting obsolete triggers on the TRANSMISSION REQUIRED field")
18 D MES^XPDUTL(" (#.04) of the TRANSMITTED OUTPATIENT ENCOUNTER file (#409.73).")
19 D MES^XPDUTL("")
20 ;Get last x-ref number
21 S XPDIDTOT=+$O(^DD(409.73,.04,1,""),-1)
22 ;Loop through list of x-refs
23 S XREFNUM=0
24 F S XREFNUM=+$O(^DD(409.73,.04,1,XREFNUM)) Q:('XREFNUM) D
25 .;If KIDS install, show progress through status bar
26 .D:($G(XPDNM)'="") UPDATE^XPDID(XREFNUM)
27 .;Grab zero node
28 .S NODE=$G(^DD(409.73,.04,1,XREFNUM,0))
29 .;Make sure it's a trigger x-ref
30 .Q:($P(NODE,"^",3)'="TRIGGER")
31 .;Make sure it triggers a field in 409.73
32 .Q:($P(NODE,"^",4)'=409.73)
33 .;Make sure it's one of the fields that should no longer be triggered
34 .S X=","_(+$P(NODE,"^",5))_","
35 .Q:(",11,12,13,14,15,"'[X)
36 .;Obsolete triggers delete their triggered fields
37 .Q:($G(^DD(409.73,.04,1,XREFNUM,"CREATE VALUE"))'="@")
38 .;Delete obsolete trigger
39 .S DIK="^DD(409.73,.04,1,"
40 .S DA(2)=409.73
41 .S DA(1)=.04
42 .S DA=XREFNUM
43 .D ^DIK
44 .S X=" Trigger cross reference number "_XREFNUM_" deleted"
45 .D MES^XPDUTL(X)
46 D BMES^XPDUTL("")
47 Q
48 ;
49ERRCODE ;Update ERROR CODE DESCRIPTION field (#11) of the TRANSMITTED
50 ; OUTPATIENT ENCOUNTER ERROR CODE file (#409.76) for error codes
51 ; 420 & 105 (AAC changed descriptions to reflect receipt of info
52 ; past close-out)
53 ;
54 ;Declare variables
55 N SD53FDA,SD53IEN,SD53MSG
56 ;Print info
57 D BMES^XPDUTL(">>> Updating the ERROR CODE DESCRIPTION field (#11) of")
58 D MES^XPDUTL(" the TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE file")
59 D MES^XPDUTL(" (#409.76) for error codes 420 and 105. Definitions")
60 D MES^XPDUTL(" were modified to reflect receipt of data by NPCD")
61 D MES^XPDUTL(" after close-out.")
62 D MES^XPDUTL("")
63 ;Set up call to FileMan Updater (call will find/create entry)
64 S SD53FDA(409.76,"?+1,",.01)=420
65 S SD53FDA(409.76,"?+1,",11)="Date of Encounter is invalid, after date of transmission, or after close-out."
66 S SD53FDA(409.76,"?+2,",.01)=105
67 S SD53FDA(409.76,"?+2,",11)="Event Date is missing, invalid, after processing date, or after close-out."
68 ;Call FileMan Updater
69 D UPDATE^DIE("ES","SD53FDA","SD53IEN","SD53MSG")
70 ;Error
71 I ($D(SD53MSG("DIERR"))) D
72 .N SD53TMP
73 .D BMES^XPDUTL(" *** The following error occurred while updating descriptions ***")
74 .D MSG^DIALOG("ASE",.SD53TMP,70,5,"SD53MSG")
75 .D MES^XPDUTL("")
76 .D MES^XPDUTL(.SD53TMP)
77 D BMES^XPDUTL("")
78 Q
79 ;
80MGCHK ;Check to see if the LATE ACTIVITY MAIL GROUP field (#217) of the
81 ; MAS PARAMETERS file (#43) contains a valid mail group
82 ;
83 ;Declare variables
84 N NODE,XMDUZ,XMY,OK
85 S OK=1
86 ;Print header
87 D BMES^XPDUTL(">>> Checking for existance of a valid mail group in the")
88 D MES^XPDUTL(" LATE ACTIVITY MAIL GROUP field (#217) of the MAS")
89 D MES^XPDUTL(" PARAMETERS file (#43). Members of this mail group")
90 D MES^XPDUTL(" will be notified of all late National Patient Care")
91 D MES^XPDUTL(" Database activity.")
92 D MES^XPDUTL("")
93 ;Get pointer to mail group
94 S NODE=$G(^DG(43,1,"SCLR"))
95 S:('$P(NODE,"^",17)) OK=0
96 ;Use call that builds XMY() - will validate pointer (also sets XMDUZ)
97 I (OK) D XMY^SDUTL2($P(NODE,"^",17),0,0) S:('$D(XMY)) OK=0
98 ;Valid mail group
99 I (OK) D
100 .S XMDUZ=$O(XMY(""))
101 .D BMES^XPDUTL(" Late NPCD activity will be delivered to members of")
102 .D MES^XPDUTL(" the "_$P(XMDUZ,".",2)_" mail group")
103 ;Valid mail group not found
104 I ('OK) D
105 .D BMES^XPDUTL(" *** Valid mail group not found")
106 .D BMES^XPDUTL(" *** Notification of late NPCD activity will not occur")
107 .D BMES^XPDUTL(" *** Use the Scheduling Parameters option [SD PARM PARAMETERS]")
108 .D MES^XPDUTL(" to select a mail group that will receive the notifications")
109 D BMES^XPDUTL("")
110 Q
111 ;
112SEED ;Seed NPCD ENCOUNTER MONTH multiple (#404.9171) of the SCHEDULING
113 ; PARAMETER file (#404.91) with close-out dates for fiscal year 1997
114 ;
115 ;Declare variables
116 N XPDIDTOT,LINE,DATES,WLMONTH,DBCLOSE,WLCLOSE,TMP
117 ;Print header
118 D BMES^XPDUTL(">>> Storing close-out dates for Fiscal Year 1997")
119 S TMP=$$INSERT^SCDXUTL1("Workload","",7)
120 S TMP=$$INSERT^SCDXUTL1("Database",TMP,27)
121 S TMP=$$INSERT^SCDXUTL1("Workload",TMP,47)
122 D BMES^XPDUTL(TMP)
123 S TMP=$$INSERT^SCDXUTL1("Occured In","",6)
124 S TMP=$$INSERT^SCDXUTL1("Close-Out",TMP,27)
125 S TMP=$$INSERT^SCDXUTL1("Close-Out",TMP,47)
126 D MES^XPDUTL(TMP)
127 S TMP=$$INSERT^SCDXUTL1("------------","",5)
128 S TMP=$$INSERT^SCDXUTL1("------------",TMP,25)
129 S TMP=$$INSERT^SCDXUTL1("------------",TMP,45)
130 D MES^XPDUTL(TMP)
131 ;Loop through list of dates
132 S XPDIDTOT=12
133 F LINE=2:1:13 S TMP=$T(FY97+LINE),DATES=$P(TMP,";",3) Q:(DATES="") D
134 .;Break out info
135 .S WLMONTH=$P(DATES,"^",1)
136 .S DBCLOSE=$P(DATES,"^",2)
137 .S WLCLOSE=$P(DATES,"^",3)
138 .;Print close-out info
139 .S TMP=$$INSERT^SCDXUTL1($$FMTE^XLFDT(WLMONTH,"1D"),"",7)
140 .S TMP=$$INSERT^SCDXUTL1($$FMTE^XLFDT(DBCLOSE,"1D"),TMP,25)
141 .S TMP=$$INSERT^SCDXUTL1($$FMTE^XLFDT(WLCLOSE,"1D"),TMP,45)
142 .D MES^XPDUTL(TMP)
143 .;Store close-out info
144 .S TMP=$$AECLOSE^SCDXFU04(WLMONTH,DBCLOSE,WLCLOSE)
145 .;If KIDS install, show progress through status bar
146 .D:($G(XPDNM)'="") UPDATE^XPDID(LINE-1)
147 D BMES^XPDUTL("")
148 Q
149 ;
150FY97 ;Close-out dates for fiscal year 1997
151 ; Month ^ Database Close-Out ^ Workload Close-Out
152 ;;2961000^2970430^2970331
153 ;;2961100^2970430^2970331
154 ;;2961200^2970430^2970331
155 ;;2970100^2970430^2970331
156 ;;2970200^2970430^2970331
157 ;;2970300^2970430^2970430
158 ;;2970400^2971031^2970531
159 ;;2970500^2971031^2970630
160 ;;2970600^2971031^2970731
161 ;;2970700^2971031^2970831
162 ;;2970800^2971031^2970930
163 ;;2970900^2971031^2971031
164 ;
Note: See TracBrowser for help on using the repository browser.