Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XU8P344

XU8P344.m

Go to the documentation of this file. 
  1. XU8P344 ;SFISC/SO- POST INSTALL ;7:01 AM  8 Jun 2005
  1.  ;;8.0;KERNEL;**344**;Jul 10, 1995
  1.  D P1
  1.  D P2
  1.  D P3
  1.  Q
  1.  ;
  1. P1 ; Loop thru New Person file and change field #12.3 to 6/_year
  1.  ; Then try and determine Training Facility
  1.  D MES^XPDUTL("Begin Updating...")
  1.  N IEN S IEN=0
  1.  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'
  1.  . N LASTYR S LASTYR=""
  1.  . N DIVISION S DIVISION=0
  1.  . N DNLT S DNLT=""
  1.  . N YN S YN=""
  1.  . ;
  1.  . D  ; Last Training Month & Year
  1.  .. N DIERR,Z,ZERR
  1.  .. S LASTYR=$$GET1^DIQ(200,IEN_",",12.3,"I","Z","ZERR")
  1.  .. I LASTYR'="",LASTYR'["/" D
  1.  ... I $L(LASTYR)=5 S LASTYR=$E(LASTYR)_"/"_$E(LASTYR,2,5)
  1.  ... I $L(LASTYR)=6 S LASTYR=$E(LASTYR,1,2)_"/"_$E(LASTYR,3,6)
  1.  .. I LASTYR'="",LASTYR["/" D
  1.  ... I $L(LASTYR,"/")=1 S LASTYR="6/"_LASTYR Q
  1.  ... S LASTYR=$P(LASTYR,"/")_"/"_$P(LASTYR,"/",$L(LASTYR,"/")) Q
  1.  ... Q
  1.  .. Q
  1.  . ;
  1.  . D  ; VHA Training Facility
  1.  .. N DIERR,Z,ZERR
  1.  .. S DIVISION=+$$GET1^DIQ(200,IEN,12.4,"I","Z","ZERR")
  1.  .. I DIVISION,$$SCRN4^XUOAAUTL(DIVISION) Q  ;VHA TRAINING FACILITY DEFINED
  1.  .. I DIVISION S DIVISION=0 ;FAILED ABOVE CHECK
  1.  .. D GETS^DIQ(200,IEN,"16*","I","Z","ZERR") ;Get Division multiple
  1.  .. N DIEN S DIEN=""
  1.  .. F  S DIEN=$O(Z(200.02,DIEN)) Q:DIEN=""  D
  1.  ... 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
  1.  ... Q
  1.  .. I 'DIVISION S DIVISION=$P($$NS^XUAF4($$KSP^XUPARAM("INST")),U,2),DIVISION=$$LKUP^XUAF4(DIVISION)
  1.  .. Q
  1.  . ;
  1.  . D  ; Use Termination Date if necessary
  1.  .. N DIERR,Z,ZERR
  1.  .. S DNLT=$$GET1^DIQ(200,IEN_",",12.7,"I","Z","ZERR")
  1.  .. I DNLT'="" S:DNLT'<DT DNLT="" Q  ;Date established and Not in the future
  1.  .. S DNLT=$$GET1^DIQ(200,IEN_",",9.2,"I","Z","ZERR")
  1.  .. S:DNLT'<DT DNLT="" ;Reset if a Future termination date
  1.  .. Q
  1.  . ;
  1.  . D  ; Update Record
  1.  .. N DIERR,FDA,ZERR
  1.  .. S FDA(200,IEN_",",12.3)=LASTYR
  1.  .. S FDA(200,IEN_",",12.4)=DIVISION
  1.  .. S FDA(200,IEN_",",12.6)=$S(DNLT'="":"N",1:"Y")
  1.  .. S FDA(200,IEN_",",12.7)=DNLT
  1.  .. D FILE^DIE("I","FDA","ZERR")
  1.  .. Q
  1.  . Q
  1.  D MES^XPDUTL("Finished updates.")
  1.  Q
  1.  ;
  1. P2 ; Transmitt Data to OAA database
  1.  I $E($G(XPDQUES("POS1")))="P" D  Q
  1.  . ;Let's be sure eveone is accounted for
  1.  . D MES^XPDUTL("Reindexing ""ATR"" cross reference...")
  1.  . N DIK
  1.  . S DIK="^VA(200,"
  1.  . S DIK(1)="12.2^ATR"
  1.  . D ENALL^DIK
  1.  . D MES^XPDUTL("Done reindexing ""ATR"" cross reference.")
  1.  . ;
  1.  . D MES^XPDUTL("Begin transmission of OAA data...")
  1.  . D OAA^XUOAAHL7
  1.  . D MES^XPDUTL("Done with transmission of OAA data.")
  1.  . Q
  1.  D MES^XPDUTL("Non-production account.  No transmission of OAA data will take place.") K ^VA(200,"ATR") Q
  1.  Q
  1.  ;
  1. P3 ; Change Rescheduling Frequency for XUOAA SEND HL7 MESSAGE to '1D'
  1.  I $E($G(XPDQUES("POS1")))="P" D  Q
  1.  . N DIERR,Z,ZERR
  1.  . D FIND^DIC(19.2,"","@;.01","P","XUOAA SEND HL7 MESSAGE","","","","","Z","ZERR")
  1.  . I $D(DIERR) D MES^XPDUTL("Can not find option ""XUOAA SEND HL7 MESSAGE"" in OPTION SCHEDULING(#19.2) file.") Q
  1.  . I +Z("DILIST",0)>1 D MES^XPDUTL("More than one ""XUOAA SEND HL7 MESSAGE"" scheduled.  Can not reschedule.") Q
  1.  . N IEN,FDA
  1.  . S IEN=+Z("DILIST",1,0)_","
  1.  . S FDA(19.2,IEN,6)="1D"
  1.  . D FILE^DIE("E","FDA","ZERR")
  1.  Q