VAFCCOPT ;ALB/CM/PHH/EG/GAH OUTPATIENT APPT (HL7 MESS) NIGHT JOB ; 10/18/06
;;5.3;Registration;**91,298,568,585,725**;Jun 06, 1996;Build 12
;hl7v1.6
;This routine will loop through the Hospital Location file "S" node
;and generate an HL7-v2.3 A08 message for all appointments for today
;that have a status of "No action taken" or "Future"
;the HL7 message is not batch.
;
;07/07/00 ACS - Added sequence 39 (facility+suffix) to the outpatient
;string of fields
;
;Check to see if sending v2.3 is on or off
EN I '$P($$SEND^VAFHUTL(),"^",2) Q
;
S ERRB="^TMP($J,""ADT-ERR"","
;
N STAT,X1,X2
;This job should be set to run after midnight daily.
D NOW^%DTC S START=X
S X1=START,X2=1 D C^%DTC S STOP=X K X1,X2,%H,X,%,%I
S ENT=0,GBL="^TMP(""HLS"",$J)"
;
K HL D INIT^HLFNC2("VAFC ADT-A08-SCHED SERVER",.HL)
I $D(HL)=1 DO QUIT
.I $P(HL,"^",2)="Server Protocol Disabled"
.E S @ERRB@(1)=HL D EBULL^VAFHUTL2("","","",ERRB)
;
S PSTR="2,3,7,10,18,39,44,50"
;
N DGARRAY,DGCNT
S COUNT=0
F S ENT=$O(^SC(ENT)) Q:(ENT="")!(ENT'?.N) D
.S ENT1=START
.S DGARRAY(1)=START_";"_STOP,DGARRAY("FLDS")="1;3",DGARRAY(2)=ENT
.S DGCNT=$$SDAPI^SDAMA301(.DGARRAY)
.;
.I DGCNT>0 S DFN=0 F S DFN=$O(^TMP($J,"SDAMA301",ENT,DFN)) Q:DFN="" D
..Q:'$D(^DPT(DFN,0))
..S ENT1=0 F S ENT1=$O(^TMP($J,"SDAMA301",ENT,DFN,ENT1)) Q:ENT1=""!(ENT1'?.N1".".N) D
...S STAT=$P($P(^TMP($J,"SDAMA301",ENT,DFN,ENT1),"^",3),";")
...I STAT="NT" S ERR=$$CREATE() I +ERR>0 S VPTR=$P(ERR,"^",6) D GEN
...I +$G(ERR)<0 S @ERRB@(1)=ERR D EBULL^VAFHUTL2("","","",ERRB)
.I DGCNT'=0 K ^TMP($J,"SDAMA301")
D EXIT
Q
;
GEN I COUNT DO ;first time through its been done
. K HL D INIT^HLFNC2("VAFC ADT-A08-SCHED SERVER",.HL)
. I $D(HL)=1 DO
. . S @ERRB@(1)=HL D EBULL^VAFHUTL2("","","",ERRB)
I $D(HL)=1 S ENT="ZZZZEND",ENT1=9999999,ENT2=9999999 Q
;
;
;Generate the following segments:
;EVN
S EVN=$$EVN^VAFHLEVN("A08","05")
I +EVN=-1 S ERR="-1^Unable to generate EVN segment" Q
;PID
S VAFPID=$$EN^VAFCPID(DFN,"2,3,4,5,6,7,8,9,11,12,13,14,16,19,29,30")
;ZPD
S ZPD=$$EN^VAFHLZPD(DFN,"2,3,4,5,6,7,8,9,10,11,12,13,14,15")
;PV1 (outpatient)
S PV1=$$OUT^VAFHLPV1(DFN,EVENT,EVDT,VPTR,PSTR)
I +PV1=-1 S ERR="-1^Unable to generate PV1 segment" Q
;
; no dg1 segment will be created. No diagnosis
; information will be known at this stage.
S COUNT=1
K ^TMP("HLS",$J)
;
;
S @GBL@(COUNT)=EVN,COUNT=COUNT+1
MERGE @GBL@(COUNT)=VAFPID S COUNT=COUNT+1
S @GBL@(COUNT)=ZPD,COUNT=COUNT+1
S @GBL@(COUNT)=PV1
;
D GENERATE^HLMA("VAFC ADT-A08-SCHED SERVER","GM",1,,.HLRST)
I $L($P(HLRST,2,99)) DO
. S @ERRB@(1)=HLRST D EBULL^VAFHUTL2("","","",ERRB)
. S ERRCNT=$G(ERRCNT)+1
. I $G(ERRCNT)>10 S ENT="ZZZZEND",ENT1=9999999,ENT2=9999999
Q
;
EXIT K HLERR
;
D KILL^HLTRANS
K ERRCNT,VAFPID,^TMP("HLS",$J),SEQ,RESULT,MID
K PSTR,ZPD,DG1,PID,PV1,MSH,EVN,ENT,ENT1,ENT2,DFN,START,STOP,GBL,HLSDT
K EVDT,HLMTN,EVENT,COUNT,HLEVN,HLENTRY,ERR,VPTR,ERRB
Q
;
CREATE() ;
;creates new entry in pivot file
N NODE,VPTR
S EVDT=ENT1,VPTR=DFN_";DPT("
S NODE=$$PIVNW^VAFHPIVT(DFN,EVDT,2,VPTR)
I +NODE=-1 Q NODE
S EVENT=$P(NODE,":")
Q EVENT_"^"_NODE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCCOPT 3226 printed Dec 13, 2024@03:01:35 Page 2
VAFCCOPT ;ALB/CM/PHH/EG/GAH OUTPATIENT APPT (HL7 MESS) NIGHT JOB ; 10/18/06
+1 ;;5.3;Registration;**91,298,568,585,725**;Jun 06, 1996;Build 12
+2 ;hl7v1.6
+3 ;This routine will loop through the Hospital Location file "S" node
+4 ;and generate an HL7-v2.3 A08 message for all appointments for today
+5 ;that have a status of "No action taken" or "Future"
+6 ;the HL7 message is not batch.
+7 ;
+8 ;07/07/00 ACS - Added sequence 39 (facility+suffix) to the outpatient
+9 ;string of fields
+10 ;
+11 ;Check to see if sending v2.3 is on or off
EN IF '$PIECE($$SEND^VAFHUTL(),"^",2)
QUIT
+1 ;
+2 SET ERRB="^TMP($J,""ADT-ERR"","
+3 ;
+4 NEW STAT,X1,X2
+5 ;This job should be set to run after midnight daily.
+6 DO NOW^%DTC
SET START=X
+7 SET X1=START
SET X2=1
DO C^%DTC
SET STOP=X
KILL X1,X2,%H,X,%,%I
+8 SET ENT=0
SET GBL="^TMP(""HLS"",$J)"
+9 ;
+10 KILL HL
DO INIT^HLFNC2("VAFC ADT-A08-SCHED SERVER",.HL)
+11 IF $DATA(HL)=1
Begin DoDot:1
+12 IF $PIECE(HL,"^",2)="Server Protocol Disabled"
+13 IF '$TEST
SET @ERRB@(1)=HL
DO EBULL^VAFHUTL2("","","",ERRB)
End DoDot:1
QUIT
+14 ;
+15 SET PSTR="2,3,7,10,18,39,44,50"
+16 ;
+17 NEW DGARRAY,DGCNT
+18 SET COUNT=0
+19 FOR
SET ENT=$ORDER(^SC(ENT))
if (ENT="")!(ENT'?.N)
QUIT
Begin DoDot:1
+20 SET ENT1=START
+21 SET DGARRAY(1)=START_";"_STOP
SET DGARRAY("FLDS")="1;3"
SET DGARRAY(2)=ENT
+22 SET DGCNT=$$SDAPI^SDAMA301(.DGARRAY)
+23 ;
+24 IF DGCNT>0
SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"SDAMA301",ENT,DFN))
if DFN=""
QUIT
Begin DoDot:2
+25 if '$DATA(^DPT(DFN,0))
QUIT
+26 SET ENT1=0
FOR
SET ENT1=$ORDER(^TMP($JOB,"SDAMA301",ENT,DFN,ENT1))
if ENT1=""!(ENT1'?.N1".".N)
QUIT
Begin DoDot:3
+27 SET STAT=$PIECE($PIECE(^TMP($JOB,"SDAMA301",ENT,DFN,ENT1),"^",3),";")
+28 IF STAT="NT"
SET ERR=$$CREATE()
IF +ERR>0
SET VPTR=$PIECE(ERR,"^",6)
DO GEN
+29 IF +$GET(ERR)<0
SET @ERRB@(1)=ERR
DO EBULL^VAFHUTL2("","","",ERRB)
End DoDot:3
End DoDot:2
+30 IF DGCNT'=0
KILL ^TMP($JOB,"SDAMA301")
End DoDot:1
+31 DO EXIT
+32 QUIT
+33 ;
GEN ;first time through its been done
IF COUNT
Begin DoDot:1
+1 KILL HL
DO INIT^HLFNC2("VAFC ADT-A08-SCHED SERVER",.HL)
+2 IF $DATA(HL)=1
Begin DoDot:2
+3 SET @ERRB@(1)=HL
DO EBULL^VAFHUTL2("","","",ERRB)
End DoDot:2
End DoDot:1
+4 IF $DATA(HL)=1
SET ENT="ZZZZEND"
SET ENT1=9999999
SET ENT2=9999999
QUIT
+5 ;
+6 ;
+7 ;Generate the following segments:
+8 ;EVN
+9 SET EVN=$$EVN^VAFHLEVN("A08","05")
+10 IF +EVN=-1
SET ERR="-1^Unable to generate EVN segment"
QUIT
+11 ;PID
+12 SET VAFPID=$$EN^VAFCPID(DFN,"2,3,4,5,6,7,8,9,11,12,13,14,16,19,29,30")
+13 ;ZPD
+14 SET ZPD=$$EN^VAFHLZPD(DFN,"2,3,4,5,6,7,8,9,10,11,12,13,14,15")
+15 ;PV1 (outpatient)
+16 SET PV1=$$OUT^VAFHLPV1(DFN,EVENT,EVDT,VPTR,PSTR)
+17 IF +PV1=-1
SET ERR="-1^Unable to generate PV1 segment"
QUIT
+18 ;
+19 ; no dg1 segment will be created. No diagnosis
+20 ; information will be known at this stage.
+21 SET COUNT=1
+22 KILL ^TMP("HLS",$JOB)
+23 ;
+24 ;
+25 SET @GBL@(COUNT)=EVN
SET COUNT=COUNT+1
+26 MERGE @GBL@(COUNT)=VAFPID
SET COUNT=COUNT+1
+27 SET @GBL@(COUNT)=ZPD
SET COUNT=COUNT+1
+28 SET @GBL@(COUNT)=PV1
+29 ;
+30 DO GENERATE^HLMA("VAFC ADT-A08-SCHED SERVER","GM",1,,.HLRST)
+31 IF $LENGTH($PIECE(HLRST,2,99))
Begin DoDot:1
+32 SET @ERRB@(1)=HLRST
DO EBULL^VAFHUTL2("","","",ERRB)
+33 SET ERRCNT=$GET(ERRCNT)+1
+34 IF $GET(ERRCNT)>10
SET ENT="ZZZZEND"
SET ENT1=9999999
SET ENT2=9999999
End DoDot:1
+35 QUIT
+36 ;
EXIT KILL HLERR
+1 ;
+2 DO KILL^HLTRANS
+3 KILL ERRCNT,VAFPID,^TMP("HLS",$JOB),SEQ,RESULT,MID
+4 KILL PSTR,ZPD,DG1,PID,PV1,MSH,EVN,ENT,ENT1,ENT2,DFN,START,STOP,GBL,HLSDT
+5 KILL EVDT,HLMTN,EVENT,COUNT,HLEVN,HLENTRY,ERR,VPTR,ERRB
+6 QUIT
+7 ;
CREATE() ;
+1 ;creates new entry in pivot file
+2 NEW NODE,VPTR
+3 SET EVDT=ENT1
SET VPTR=DFN_";DPT("
+4 SET NODE=$$PIVNW^VAFHPIVT(DFN,EVDT,2,VPTR)
+5 IF +NODE=-1
QUIT NODE
+6 SET EVENT=$PIECE(NODE,":")
+7 QUIT EVENT_"^"_NODE
