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

VAFHBGJ.m

Go to the documentation of this file.
  1. VAFHBGJ ;ALB/CM BACKGROUND JOB FOR UPDATE MESSAGES ;05/23/95
  1. ;;5.3;Registration;**91,415**;Jun 06, 1996
  1. ;
  1. ;This routine will loop through the pivot file, getting the entries
  1. ;that have the TRANSMITTED-NEED TO TRANSMIT field populated and
  1. ; generating an A08 message for the update.
  1. ;
  1. ;
  1. EN ;check to see if sending is on or off
  1. I '$$SEND^VAFHUTL() Q
  1. ;make sure only one job will run
  1. ENT L +^XTMP("ADT/HL7 VAFH BATCH UPDATE"):3 E Q
  1. ;
  1. D MAIN
  1. K HLA D KILL^HLTRANS
  1. L -^XTMP("ADT/HL7 VAFH BATCH UPDATE")
  1. Q
  1. ;
  1. MAIN N LSTR,LOOP,NODE,DFN,RECENT,EVTY,EVDT,PIVOT,VPTR,GBL,COUNT,UP,ERR,CLEAN
  1. I '$O(^VAT(391.71,"AC",1,"")) Q
  1. S LOOP="",GBL="HLA(""HLS"")"
  1. K HLA
  1. ;
  1. F S COUNT=1,LOOP=$O(^VAT(391.71,"AC",1,LOOP)) Q:LOOP="" D Q:$D(HL)=1
  1. .; bad x-ref, delete it and quit
  1. .I '$D(^VAT(391.71,LOOP)) K ^VAT(391.71,"AC",1,LOOP) Q
  1. .S NODE=$G(^VAT(391.71,LOOP,0)) Q:'NODE
  1. .K HL D INIT^HLFNC2("VAFH A08",.HL)
  1. .I $D(HL)=1 Q
  1. .I LOOP#10=0,+$$S^%ZTLOAD K HL S HL="TaskMan User Stop " Q
  1. .S DFN=$P(NODE,"^",3),PIVOT=$P(NODE,"^",2) Q:'DFN
  1. .; need to check if anything but registration
  1. .S LSTR=$P($$LTD^VAFHUTL(DFN),"^",2)
  1. .I LSTR'="R",LSTR'["No l" S LSTR=",2,50"
  1. .E S LSTR=50
  1. .;
  1. .; generate the a08 message
  1. .S ERR=$$UP^VAFHCA08(DFN,PIVOT,NODE,COUNT,GBL,"2,3,4,5,6,7,8,9,10B,11,12,13,14,16,19,22B","2,3,4,5,6,7,8,9,10,11,12,13,14,15",LSTR)
  1. .I +ERR=0 DO
  1. . .S CLEAN=$$CLNTRAN^VAFHPIV2(PIVOT),COUNT=$P(ERR,"^",2)+1
  1. .E Q
  1. .;;;I COUNT<2&($D(CLEAN)) D
  1. .I +CLEAN=-1 D ERROR^VAFHCCAP(CLEAN,DFN) Q
  1. .D GENERATE^HLMA("VAFH A08","LM",1,.HLRESLT)
  1. .K HLA
  1. Q