XU8P344 ;SFISC/SO- POST INSTALL ;7:01 AM 8 Jun 2005
;;8.0;KERNEL;**344**;Jul 10, 1995
D P1
D P2
D P3
Q
;
P1 ; Loop thru New Person file and change field #12.3 to 6/_year
; Then try and determine Training Facility
D MES^XPDUTL("Begin Updating...")
N IEN S IEN=0
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'
. N LASTYR S LASTYR=""
. N DIVISION S DIVISION=0
. N DNLT S DNLT=""
. N YN S YN=""
. ;
. D ; Last Training Month & Year
.. N DIERR,Z,ZERR
.. S LASTYR=$$GET1^DIQ(200,IEN_",",12.3,"I","Z","ZERR")
.. I LASTYR'="",LASTYR'["/" D
... I $L(LASTYR)=5 S LASTYR=$E(LASTYR)_"/"_$E(LASTYR,2,5)
... I $L(LASTYR)=6 S LASTYR=$E(LASTYR,1,2)_"/"_$E(LASTYR,3,6)
.. I LASTYR'="",LASTYR["/" D
... I $L(LASTYR,"/")=1 S LASTYR="6/"_LASTYR Q
... S LASTYR=$P(LASTYR,"/")_"/"_$P(LASTYR,"/",$L(LASTYR,"/")) Q
... Q
.. Q
. ;
. D ; VHA Training Facility
.. N DIERR,Z,ZERR
.. S DIVISION=+$$GET1^DIQ(200,IEN,12.4,"I","Z","ZERR")
.. I DIVISION,$$SCRN4^XUOAAUTL(DIVISION) Q ;VHA TRAINING FACILITY DEFINED
.. I DIVISION S DIVISION=0 ;FAILED ABOVE CHECK
.. D GETS^DIQ(200,IEN,"16*","I","Z","ZERR") ;Get Division multiple
.. N DIEN S DIEN=""
.. F S DIEN=$O(Z(200.02,DIEN)) Q:DIEN="" D
... 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
... Q
.. I 'DIVISION S DIVISION=$P($$NS^XUAF4($$KSP^XUPARAM("INST")),U,2),DIVISION=$$LKUP^XUAF4(DIVISION)
.. Q
. ;
. D ; Use Termination Date if necessary
.. N DIERR,Z,ZERR
.. S DNLT=$$GET1^DIQ(200,IEN_",",12.7,"I","Z","ZERR")
.. I DNLT'="" S:DNLT'<DT DNLT="" Q ;Date established and Not in the future
.. S DNLT=$$GET1^DIQ(200,IEN_",",9.2,"I","Z","ZERR")
.. S:DNLT'<DT DNLT="" ;Reset if a Future termination date
.. Q
. ;
. D ; Update Record
.. N DIERR,FDA,ZERR
.. S FDA(200,IEN_",",12.3)=LASTYR
.. S FDA(200,IEN_",",12.4)=DIVISION
.. S FDA(200,IEN_",",12.6)=$S(DNLT'="":"N",1:"Y")
.. S FDA(200,IEN_",",12.7)=DNLT
.. D FILE^DIE("I","FDA","ZERR")
.. Q
. Q
D MES^XPDUTL("Finished updates.")
Q
;
P2 ; Transmitt Data to OAA database
I $E($G(XPDQUES("POS1")))="P" D Q
. ;Let's be sure eveone is accounted for
. D MES^XPDUTL("Reindexing ""ATR"" cross reference...")
. N DIK
. S DIK="^VA(200,"
. S DIK(1)="12.2^ATR"
. D ENALL^DIK
. D MES^XPDUTL("Done reindexing ""ATR"" cross reference.")
. ;
. D MES^XPDUTL("Begin transmission of OAA data...")
. D OAA^XUOAAHL7
. D MES^XPDUTL("Done with transmission of OAA data.")
. Q
D MES^XPDUTL("Non-production account. No transmission of OAA data will take place.") K ^VA(200,"ATR") Q
Q
;
P3 ; Change Rescheduling Frequency for XUOAA SEND HL7 MESSAGE to '1D'
I $E($G(XPDQUES("POS1")))="P" D Q
. N DIERR,Z,ZERR
. D FIND^DIC(19.2,"","@;.01","P","XUOAA SEND HL7 MESSAGE","","","","","Z","ZERR")
. I $D(DIERR) D MES^XPDUTL("Can not find option ""XUOAA SEND HL7 MESSAGE"" in OPTION SCHEDULING(#19.2) file.") Q
. I +Z("DILIST",0)>1 D MES^XPDUTL("More than one ""XUOAA SEND HL7 MESSAGE"" scheduled. Can not reschedule.") Q
. N IEN,FDA
. S IEN=+Z("DILIST",1,0)_","
. S FDA(19.2,IEN,6)="1D"
. D FILE^DIE("E","FDA","ZERR")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P344 3306 printed Apr 09, 2024@21:15:24 Page 2
XU8P344 ;SFISC/SO- POST INSTALL ;7:01 AM 8 Jun 2005
+1 ;;8.0;KERNEL;**344**;Jul 10, 1995
+2 DO P1
+3 DO P2
+4 DO P3
+5 QUIT
+6 ;
P1 ; Loop thru New Person file and change field #12.3 to 6/_year
+1 ; Then try and determine Training Facility
+2 DO MES^XPDUTL("Begin Updating...")
+3 NEW IEN
SET IEN=0
+4 ; Update record If And Only If 'Program Of Study'
FOR
SET IEN=$ORDER(^VA(200,IEN))
if 'IEN
QUIT
IF +$$GET1^DIQ(200,IEN_",",12.2,"I","","ZERR")
Begin DoDot:1
+5 NEW LASTYR
SET LASTYR=""
+6 NEW DIVISION
SET DIVISION=0
+7 NEW DNLT
SET DNLT=""
+8 NEW YN
SET YN=""
+9 ;
+10 ; Last Training Month & Year
Begin DoDot:2
+11 NEW DIERR,Z,ZERR
+12 SET LASTYR=$$GET1^DIQ(200,IEN_",",12.3,"I","Z","ZERR")
+13 IF LASTYR'=""
IF LASTYR'["/"
Begin DoDot:3
+14 IF $LENGTH(LASTYR)=5
SET LASTYR=$EXTRACT(LASTYR)_"/"_$EXTRACT(LASTYR,2,5)
+15 IF $LENGTH(LASTYR)=6
SET LASTYR=$EXTRACT(LASTYR,1,2)_"/"_$EXTRACT(LASTYR,3,6)
End DoDot:3
+16 IF LASTYR'=""
IF LASTYR["/"
Begin DoDot:3
+17 IF $LENGTH(LASTYR,"/")=1
SET LASTYR="6/"_LASTYR
QUIT
+18 SET LASTYR=$PIECE(LASTYR,"/")_"/"_$PIECE(LASTYR,"/",$LENGTH(LASTYR,"/"))
QUIT
+19 QUIT
End DoDot:3
+20 QUIT
End DoDot:2
+21 ;
+22 ; VHA Training Facility
Begin DoDot:2
+23 NEW DIERR,Z,ZERR
+24 SET DIVISION=+$$GET1^DIQ(200,IEN,12.4,"I","Z","ZERR")
+25 ;VHA TRAINING FACILITY DEFINED
IF DIVISION
IF $$SCRN4^XUOAAUTL(DIVISION)
QUIT
+26 ;FAILED ABOVE CHECK
IF DIVISION
SET DIVISION=0
+27 ;Get Division multiple
DO GETS^DIQ(200,IEN,"16*","I","Z","ZERR")
+28 NEW DIEN
SET DIEN=""
+29 FOR
SET DIEN=$ORDER(Z(200.02,DIEN))
if DIEN=""
QUIT
Begin DoDot:3
+30 IF $GET(Z(200.02,DIEN,1,"I"))
SET DIVISION=$GET(Z(200.02,DIEN,.01,"I"))
SET DIVISION=$SELECT($$SCRN4^XUOAAUTL(DIVISION):DIVISION,1:0)
QUIT
+31 QUIT
End DoDot:3
+32 IF 'DIVISION
SET DIVISION=$PIECE($$NS^XUAF4($$KSP^XUPARAM("INST")),U,2)
SET DIVISION=$$LKUP^XUAF4(DIVISION)
+33 QUIT
End DoDot:2
+34 ;
+35 ; Use Termination Date if necessary
Begin DoDot:2
+36 NEW DIERR,Z,ZERR
+37 SET DNLT=$$GET1^DIQ(200,IEN_",",12.7,"I","Z","ZERR")
+38 ;Date established and Not in the future
IF DNLT'=""
if DNLT'<DT
SET DNLT=""
QUIT
+39 SET DNLT=$$GET1^DIQ(200,IEN_",",9.2,"I","Z","ZERR")
+40 ;Reset if a Future termination date
if DNLT'<DT
SET DNLT=""
+41 QUIT
End DoDot:2
+42 ;
+43 ; Update Record
Begin DoDot:2
+44 NEW DIERR,FDA,ZERR
+45 SET FDA(200,IEN_",",12.3)=LASTYR
+46 SET FDA(200,IEN_",",12.4)=DIVISION
+47 SET FDA(200,IEN_",",12.6)=$SELECT(DNLT'="":"N",1:"Y")
+48 SET FDA(200,IEN_",",12.7)=DNLT
+49 DO FILE^DIE("I","FDA","ZERR")
+50 QUIT
End DoDot:2
+51 QUIT
End DoDot:1
+52 DO MES^XPDUTL("Finished updates.")
+53 QUIT
+54 ;
P2 ; Transmitt Data to OAA database
+1 IF $EXTRACT($GET(XPDQUES("POS1")))="P"
Begin DoDot:1
+2 ;Let's be sure eveone is accounted for
+3 DO MES^XPDUTL("Reindexing ""ATR"" cross reference...")
+4 NEW DIK
+5 SET DIK="^VA(200,"
+6 SET DIK(1)="12.2^ATR"
+7 DO ENALL^DIK
+8 DO MES^XPDUTL("Done reindexing ""ATR"" cross reference.")
+9 ;
+10 DO MES^XPDUTL("Begin transmission of OAA data...")
+11 DO OAA^XUOAAHL7
+12 DO MES^XPDUTL("Done with transmission of OAA data.")
+13 QUIT
End DoDot:1
QUIT
+14 DO MES^XPDUTL("Non-production account. No transmission of OAA data will take place.")
KILL ^VA(200,"ATR")
QUIT
+15 QUIT
+16 ;
P3 ; Change Rescheduling Frequency for XUOAA SEND HL7 MESSAGE to '1D'
+1 IF $EXTRACT($GET(XPDQUES("POS1")))="P"
Begin DoDot:1
+2 NEW DIERR,Z,ZERR
+3 DO FIND^DIC(19.2,"","@;.01","P","XUOAA SEND HL7 MESSAGE","","","","","Z","ZERR")
+4 IF $DATA(DIERR)
DO MES^XPDUTL("Can not find option ""XUOAA SEND HL7 MESSAGE"" in OPTION SCHEDULING(#19.2) file.")
QUIT
+5 IF +Z("DILIST",0)>1
DO MES^XPDUTL("More than one ""XUOAA SEND HL7 MESSAGE"" scheduled. Can not reschedule.")
QUIT
+6 NEW IEN,FDA
+7 SET IEN=+Z("DILIST",1,0)_","
+8 SET FDA(19.2,IEN,6)="1D"
+9 DO FILE^DIE("E","FDA","ZERR")
End DoDot:1
QUIT
+10 QUIT
