source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XU8P344.m@ 1437

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

initial load of WorldVistAEHR
File size: 3.1 KB
Line 
1XU8P344 ;SFISC/SO- POST INSTALL ;7:01 AM 8 Jun 2005
2 ;;8.0;KERNEL;**344**;Jul 10, 1995
3 D P1
4 D P2
5 D P3
6 Q
7 ;
8P1 ; Loop thru New Person file and change field #12.3 to 6/_year
9 ; Then try and determine Training Facility
10 D MES^XPDUTL("Begin Updating...")
11 N IEN S IEN=0
12 F S IEN=$O(^VA(200,IEN)) Q:'IEN I +$$GET1^DIQ(200,IEN_",",12.2,"I","","ZERR") D ; Update record If And Only If 'Program Of Study'
13 . N LASTYR S LASTYR=""
14 . N DIVISION S DIVISION=0
15 . N DNLT S DNLT=""
16 . N YN S YN=""
17 . ;
18 . D ; Last Training Month & Year
19 .. N DIERR,Z,ZERR
20 .. S LASTYR=$$GET1^DIQ(200,IEN_",",12.3,"I","Z","ZERR")
21 .. I LASTYR'="",LASTYR'["/" D
22 ... I $L(LASTYR)=5 S LASTYR=$E(LASTYR)_"/"_$E(LASTYR,2,5)
23 ... I $L(LASTYR)=6 S LASTYR=$E(LASTYR,1,2)_"/"_$E(LASTYR,3,6)
24 .. I LASTYR'="",LASTYR["/" D
25 ... I $L(LASTYR,"/")=1 S LASTYR="6/"_LASTYR Q
26 ... S LASTYR=$P(LASTYR,"/")_"/"_$P(LASTYR,"/",$L(LASTYR,"/")) Q
27 ... Q
28 .. Q
29 . ;
30 . D ; VHA Training Facility
31 .. N DIERR,Z,ZERR
32 .. S DIVISION=+$$GET1^DIQ(200,IEN,12.4,"I","Z","ZERR")
33 .. I DIVISION,$$SCRN4^XUOAAUTL(DIVISION) Q ;VHA TRAINING FACILITY DEFINED
34 .. I DIVISION S DIVISION=0 ;FAILED ABOVE CHECK
35 .. D GETS^DIQ(200,IEN,"16*","I","Z","ZERR") ;Get Division multiple
36 .. N DIEN S DIEN=""
37 .. F S DIEN=$O(Z(200.02,DIEN)) Q:DIEN="" D
38 ... I $G(Z(200.02,DIEN,1,"I")) S DIVISION=$G(Z(200.02,DIEN,.01,"I")) S DIVISION=$S($$SCRN4^XUOAAUTL(DIVISION):DIVISION,1:0) Q
39 ... Q
40 .. I 'DIVISION S DIVISION=$P($$NS^XUAF4($$KSP^XUPARAM("INST")),U,2),DIVISION=$$LKUP^XUAF4(DIVISION)
41 .. Q
42 . ;
43 . D ; Use Termination Date if necessary
44 .. N DIERR,Z,ZERR
45 .. S DNLT=$$GET1^DIQ(200,IEN_",",12.7,"I","Z","ZERR")
46 .. I DNLT'="" S:DNLT'<DT DNLT="" Q ;Date established and Not in the future
47 .. S DNLT=$$GET1^DIQ(200,IEN_",",9.2,"I","Z","ZERR")
48 .. S:DNLT'<DT DNLT="" ;Reset if a Future termination date
49 .. Q
50 . ;
51 . D ; Update Record
52 .. N DIERR,FDA,ZERR
53 .. S FDA(200,IEN_",",12.3)=LASTYR
54 .. S FDA(200,IEN_",",12.4)=DIVISION
55 .. S FDA(200,IEN_",",12.6)=$S(DNLT'="":"N",1:"Y")
56 .. S FDA(200,IEN_",",12.7)=DNLT
57 .. D FILE^DIE("I","FDA","ZERR")
58 .. Q
59 . Q
60 D MES^XPDUTL("Finished updates.")
61 Q
62 ;
63P2 ; Transmitt Data to OAA database
64 I $E($G(XPDQUES("POS1")))="P" D Q
65 . ;Let's be sure eveone is accounted for
66 . D MES^XPDUTL("Reindexing ""ATR"" cross reference...")
67 . N DIK
68 . S DIK="^VA(200,"
69 . S DIK(1)="12.2^ATR"
70 . D ENALL^DIK
71 . D MES^XPDUTL("Done reindexing ""ATR"" cross reference.")
72 . ;
73 . D MES^XPDUTL("Begin transmission of OAA data...")
74 . D OAA^XUOAAHL7
75 . D MES^XPDUTL("Done with transmission of OAA data.")
76 . Q
77 D MES^XPDUTL("Non-production account. No transmission of OAA data will take place.") K ^VA(200,"ATR") Q
78 Q
79 ;
80P3 ; Change Rescheduling Frequency for XUOAA SEND HL7 MESSAGE to '1D'
81 I $E($G(XPDQUES("POS1")))="P" D Q
82 . N DIERR,Z,ZERR
83 . D FIND^DIC(19.2,"","@;.01","P","XUOAA SEND HL7 MESSAGE","","","","","Z","ZERR")
84 . I $D(DIERR) D MES^XPDUTL("Can not find option ""XUOAA SEND HL7 MESSAGE"" in OPTION SCHEDULING(#19.2) file.") Q
85 . I +Z("DILIST",0)>1 D MES^XPDUTL("More than one ""XUOAA SEND HL7 MESSAGE"" scheduled. Can not reschedule.") Q
86 . N IEN,FDA
87 . S IEN=+Z("DILIST",1,0)_","
88 . S FDA(19.2,IEN,6)="1D"
89 . D FILE^DIE("E","FDA","ZERR")
90 Q
Note: See TracBrowser for help on using the repository browser.