VAFHCOPT ;ALB/CM/PKE/PHH/EG/GAH OUTPATIENT APPT (HL7 MESS) NIGHT JOB ; 10/18/06
;;5.3;Registration;**91,568,585,725**;Aug 13, 1993;Build 12
;
;This routine will loop through the Hospital Location file "S" node
;and generate an A08 message for all appointments for today
;that have a status of "No action taken" or "Future"
;
EN ;
;Check to see if sending is on or off
N GO
S GO=$$SEND^VAFHUTL()
I GO=0 Q
;
S ERRB="^TMP($J,""ADT-ERR""," K ^TMP($J,"ADT-ERR")
K HL D INIT^HLFNC2("VAFH A08",.HL)
I $D(HL)=1 S ERR="-1^"_HL QUIT
;
N STAT,X1,X2
;This job should be set to run after midnight daily.
D NOW^%DTC S START=X ;;;S START=2970101
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 ^TMP("HLS",$J)
;
N DGARRAY,DGCNT
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 ;
;Generate the following segments:
;MSH
;
K HL D INIT^HLFNC2("VAFH A08",.HL)
I $D(HL)=1 S ERR="-1^"_HL Q
;EVN
S EVN=$$EVN^VAFHLEVN("A08","05")
I +EVN=-1 S ERR="-1^Unable to generate EVN segment" Q
;PID
S PID=$$EN^VAFHLPID(DFN,"2,3,4,5,6,7,8,9,11,12,13,14,16,19")
;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,"A")
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.
;
K ^TMP("HLS",$J)
S COUNT=1
;
S @GBL@(COUNT)=EVN,COUNT=COUNT+1
S @GBL@(COUNT)=PID,COUNT=COUNT+1
S @GBL@(COUNT)=ZPD,COUNT=COUNT+1
S @GBL@(COUNT)=PV1
;
;
;
D GENERATE^HLMA("VAFH A08","GM",1,.HLRST,"",.HL)
I HLRST,$P(HLRST,"^",2)=""
E S @ERRB@(1)=HLRST D EBULL^VAFHUTL2("","","",ERRB) K HLERR
Q
EXIT ;
D KILL^HLTRANS
K @GBL
K 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[HVAFHCOPT 2679 printed Nov 22, 2024@18:12:48 Page 2
VAFHCOPT ;ALB/CM/PKE/PHH/EG/GAH OUTPATIENT APPT (HL7 MESS) NIGHT JOB ; 10/18/06
+1 ;;5.3;Registration;**91,568,585,725**;Aug 13, 1993;Build 12
+2 ;
+3 ;This routine will loop through the Hospital Location file "S" node
+4 ;and generate an A08 message for all appointments for today
+5 ;that have a status of "No action taken" or "Future"
+6 ;
EN ;
+1 ;Check to see if sending is on or off
+2 NEW GO
+3 SET GO=$$SEND^VAFHUTL()
+4 IF GO=0
QUIT
+5 ;
+6 SET ERRB="^TMP($J,""ADT-ERR"","
KILL ^TMP($JOB,"ADT-ERR")
+7 KILL HL
DO INIT^HLFNC2("VAFH A08",.HL)
+8 IF $DATA(HL)=1
SET ERR="-1^"_HL
QUIT
+9 ;
+10 NEW STAT,X1,X2
+11 ;This job should be set to run after midnight daily.
+12 ;;;S START=2970101
DO NOW^%DTC
SET START=X
+13 SET X1=START
SET X2=1
DO C^%DTC
SET STOP=X
KILL X1,X2,%H,X,%,%I
+14 ;
+15 SET ENT=0
SET GBL="^TMP(""HLS"",$J)"
KILL ^TMP("HLS",$JOB)
+16 ;
+17 NEW DGARRAY,DGCNT
+18 FOR
SET ENT=$ORDER(^SC(ENT))
if (ENT="")!(ENT'?.N)
QUIT
Begin DoDot:1
+19 SET ENT1=START
+20 SET DGARRAY(1)=START_";"_STOP
SET DGARRAY("FLDS")="1;3"
SET DGARRAY(2)=ENT
+21 SET DGCNT=$$SDAPI^SDAMA301(.DGARRAY)
+22 ;
+23 IF DGCNT>0
SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"SDAMA301",ENT,DFN))
if DFN=""
QUIT
Begin DoDot:2
+24 if '$DATA(^DPT(DFN,0))
QUIT
+25 SET ENT1=0
FOR
SET ENT1=$ORDER(^TMP($JOB,"SDAMA301",ENT,DFN,ENT1))
if ENT1=""!(ENT1'?.N1".".N)
QUIT
Begin DoDot:3
+26 SET STAT=$PIECE($PIECE(^TMP($JOB,"SDAMA301",ENT,DFN,ENT1),"^",3),";")
+27 IF STAT="NT"
SET ERR=$$CREATE()
IF +ERR>0
SET VPTR=$PIECE(ERR,"^",6)
DO GEN
+28 IF +$GET(ERR)<0
SET @ERRB@(1)=ERR
DO EBULL^VAFHUTL2("","","",ERRB)
End DoDot:3
End DoDot:2
+29 IF DGCNT'=0
KILL ^TMP($JOB,"SDAMA301")
End DoDot:1
+30 DO EXIT
+31 QUIT
+32 ;
GEN ;
+1 ;Generate the following segments:
+2 ;MSH
+3 ;
+4 KILL HL
DO INIT^HLFNC2("VAFH A08",.HL)
+5 IF $DATA(HL)=1
SET ERR="-1^"_HL
QUIT
+6 ;EVN
+7 SET EVN=$$EVN^VAFHLEVN("A08","05")
+8 IF +EVN=-1
SET ERR="-1^Unable to generate EVN segment"
QUIT
+9 ;PID
+10 SET PID=$$EN^VAFHLPID(DFN,"2,3,4,5,6,7,8,9,11,12,13,14,16,19")
+11 ;ZPD
+12 SET ZPD=$$EN^VAFHLZPD(DFN,"2,3,4,5,6,7,8,9,10,11,12,13,14,15")
+13 ;PV1 (outpatient)
+14 SET PV1=$$OUT^VAFHLPV1(DFN,EVENT,EVDT,VPTR,"A")
+15 IF +PV1=-1
SET ERR="-1^Unable to generate PV1 segment"
QUIT
+16 ;
+17 ; no dg1 segment will be created. No diagnosis
+18 ;information will be known at this stage.
+19 ;
+20 KILL ^TMP("HLS",$JOB)
+21 SET COUNT=1
+22 ;
+23 SET @GBL@(COUNT)=EVN
SET COUNT=COUNT+1
+24 SET @GBL@(COUNT)=PID
SET COUNT=COUNT+1
+25 SET @GBL@(COUNT)=ZPD
SET COUNT=COUNT+1
+26 SET @GBL@(COUNT)=PV1
+27 ;
+28 ;
+29 ;
+30 DO GENERATE^HLMA("VAFH A08","GM",1,.HLRST,"",.HL)
+31 IF HLRST
IF $PIECE(HLRST,"^",2)=""
+32 IF '$TEST
SET @ERRB@(1)=HLRST
DO EBULL^VAFHUTL2("","","",ERRB)
KILL HLERR
+33 QUIT
EXIT ;
+1 DO KILL^HLTRANS
+2 KILL @GBL
+3 KILL ZPD,DG1,PID,PV1,MSH,EVN,ENT,ENT1,ENT2,DFN,START,STOP,GBL,HLSDT
+4 KILL EVDT,HLMTN,EVENT,COUNT,HLEVN,HLENTRY,ERR,VPTR,ERRB
+5 QUIT
+6 ;
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
