DGQESC3 ;ALB/JFP - VIC PREADMIT SCAN ROUTINE ; 01/09/96
;;5.3;REGISTRATION;**73,1015**;DEC 11,1996;Build 21
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
ENS ; -- Entry point
N DIR,Y
;
S DIR(0)="YA"
S DIR("A")="Download Scheduled Admissions to the VIC card station "
S DIR("B")="NO"
S DIR("?")="Enter yes to download data."
D ^DIR
I Y D Q
.; -- New Variables
.N VAUTD
.N DATE,DFNARR,CNT,Y,ERR,SDATE,EDATE,CLINIC,DFN,LDATE,IFN,ZTSTOP,RESULTS
.N DGSNODE,DGSUB,DGJ,DGUTD,DGDV
.N DIVFLAG,DIVISION,SELDIV
.; -- Set variables
.S VAUTD=1 ; -- All divisions selected
.D NOW^%DTC S DATE=%
.S DFNARR="^TMP(""DGQE-DFN"","_$J_")"
.K @DFNARR
.S CNT=0
.; -- Check for multi divisional hospital
.I $P(^DG(43,1,"GL"),"^",2)=1 D Q:Y=-1
..D DIVISION^VAUTOMA
.; -- Download for date range
.S ERR=$$SDATE^DGQESC0()
.I ERR=-1 Q
.S SDATE=ERR
.S ERR=$$EDATE^DGQESC0(ERR)
.I ERR=-1 Q
.S EDATE=ERR
.; -- Task off job
.S DIR(0)="YA"
.S DIR("A")="Task job: "
.S DIR("B")="YES"
.S DIR("?")="Enter YES/NO to determine whether job is tasked"
.D ^DIR
.Q:$D(DIRUT)
.I Y D Q
..D BATCH
..I '$D(ZTSK) Q
..W !,"Card(s) queued, task number = "_ZTSK
.D PRESCAN
Q
;
EXIT ; -- Finish processing
I '$D(ZTQUEUED)&($P(RESULTS,"^",1)=0) W !!,CNT_" Scheduled admissions down loaded to VIC work station"
K @DFNARR
Q
;
PRESCAN ; -- Scans for scheduled admissions
I '$D(ZTQUEUED) W !!,"Note: Each dot equals a day",!,"."
; -- scan scheduled admissions
S (CLINIC,DFN)=""
S LDATE=SDATE
F S LDATE=$O(^DGS(41.1,"C",LDATE)) Q:(LDATE="")!($P(LDATE,".",1)>EDATE) D
.I '$D(ZTQUEUED) W "."
.S IFN=""
.F S IFN=$O(^DGS(41.1,"C",LDATE,IFN)) Q:IFN="" D
..S DGSNODE=$G(^DGS(41.1,IFN,0))
..; -- Check cancelled flag
..I $P(DGSNODE,"^",13)'="" Q
..; -- Check batch cancelled flag
..I $$S^%ZTLOAD D Q
...S ZTSTOP=1
..I VAUTD=0 D CHKDIV Q:'DIVFLAG
..S DFN=$P(DGSNODE,"^",1)
..; -- Places card in hold file
..S @DFNARR@(DFN)=""
HL7 ; -- Builds HL7 batch message
S DFN=""
F S DFN=$O(@DFNARR@(DFN)) Q:'DFN S CNT=CNT+1
S RESULTS=$$EVENT^DGQEHL72("A08",DFNARR)
I $D(JPTEST) W !,"Results = ",RESULTS
I '$D(ZTQUEUED)&($P(RESULTS,"^",1)=-1) D
.W !,"Scheduled admission data not downloaded. Error - ",$P(RESULTS,"^",2)
; -- Clean up variables
D EXIT
Q
;
CHKDIV ; -- Check to see if clinic is part of Division selected
; -- re-sequences array
S DGSUB="" F DGJ=1:1 S DGSUB=$O(VAUTD(DGSUB)) Q:DGSUB="" S DGUTD(DGJ)=$G(VAUTD(DGSUB))
;
S DIVFLAG=0
S DGDV=$P(DGSNODE,"^",12)
I DGDV="" S DIVFLAG=0 Q
S DIVISION=$P($G(^DG(40.8,DGDV,0)),U,1)
I DIVISION="" S DIVFLAG=0 Q
F DGJ=1:1 S SELDIV=DGUTD(DGJ) D Q:'$D(DGUTD(DGJ+1))
.I SELDIV=DIVISION S DIVFLAG=1 Q
Q
;
BATCH ; -- Batch entry point for placing cards on hold
N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,G
;
S ZTRTN="PRESCAN^DGQESC3"
S ZTDESC="Scheduled admissions download to VIC work station via HL7"
S ZTIO=""
K ZTDTH
;D NOW^%DTC S ZTDTH=%
F G="VAUTD","CNT","DFNARR","SDATE","EDATE" S:$D(@G) ZTSAVE(G)=""
S ZTSAVE("VAUTD(")=""
D ^%ZTLOAD
Q
;
END ; -- End of Code
Q
;
DGQESC3 ;ALB/JFP - VIC PREADMIT SCAN ROUTINE ; 01/09/96
+1 ;;5.3;REGISTRATION;**73,1015**;DEC 11,1996;Build 21
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
ENS ; -- Entry point
+1 NEW DIR,Y
+2 ;
+3 SET DIR(0)="YA"
+4 SET DIR("A")="Download Scheduled Admissions to the VIC card station "
+5 SET DIR("B")="NO"
+6 SET DIR("?")="Enter yes to download data."
+7 DO ^DIR
+8 IF Y
Begin DoDot:1
+9 ; -- New Variables
+10 NEW VAUTD
+11 NEW DATE,DFNARR,CNT,Y,ERR,SDATE,EDATE,CLINIC,DFN,LDATE,IFN,ZTSTOP,RESULTS
+12 NEW DGSNODE,DGSUB,DGJ,DGUTD,DGDV
+13 NEW DIVFLAG,DIVISION,SELDIV
+14 ; -- Set variables
+15 ; -- All divisions selected
SET VAUTD=1
+16 DO NOW^%DTC
SET DATE=%
+17 SET DFNARR="^TMP(""DGQE-DFN"","_$JOB_")"
+18 KILL @DFNARR
+19 SET CNT=0
+20 ; -- Check for multi divisional hospital
+21 IF $PIECE(^DG(43,1,"GL"),"^",2)=1
Begin DoDot:2
+22 DO DIVISION^VAUTOMA
End DoDot:2
IF Y=-1
QUIT
+23 ; -- Download for date range
+24 SET ERR=$$SDATE^DGQESC0()
+25 IF ERR=-1
QUIT
+26 SET SDATE=ERR
+27 SET ERR=$$EDATE^DGQESC0(ERR)
+28 IF ERR=-1
QUIT
+29 SET EDATE=ERR
+30 ; -- Task off job
+31 SET DIR(0)="YA"
+32 SET DIR("A")="Task job: "
+33 SET DIR("B")="YES"
+34 SET DIR("?")="Enter YES/NO to determine whether job is tasked"
+35 DO ^DIR
+36 IF $DATA(DIRUT)
QUIT
+37 IF Y
Begin DoDot:2
+38 DO BATCH
+39 IF '$DATA(ZTSK)
QUIT
+40 WRITE !,"Card(s) queued, task number = "_ZTSK
End DoDot:2
QUIT
+41 DO PRESCAN
End DoDot:1
QUIT
+42 QUIT
+43 ;
EXIT ; -- Finish processing
+1 IF '$DATA(ZTQUEUED)&($PIECE(RESULTS,"^",1)=0)
WRITE !!,CNT_" Scheduled admissions down loaded to VIC work station"
+2 KILL @DFNARR
+3 QUIT
+4 ;
PRESCAN ; -- Scans for scheduled admissions
+1 IF '$DATA(ZTQUEUED)
WRITE !!,"Note: Each dot equals a day",!,"."
+2 ; -- scan scheduled admissions
+3 SET (CLINIC,DFN)=""
+4 SET LDATE=SDATE
+5 FOR
SET LDATE=$ORDER(^DGS(41.1,"C",LDATE))
IF (LDATE="")!($PIECE(LDATE,".",1)>EDATE)
QUIT
Begin DoDot:1
+6 IF '$DATA(ZTQUEUED)
WRITE "."
+7 SET IFN=""
+8 FOR
SET IFN=$ORDER(^DGS(41.1,"C",LDATE,IFN))
IF IFN=""
QUIT
Begin DoDot:2
+9 SET DGSNODE=$GET(^DGS(41.1,IFN,0))
+10 ; -- Check cancelled flag
+11 IF $PIECE(DGSNODE,"^",13)'=""
QUIT
+12 ; -- Check batch cancelled flag
+13 IF $$S^%ZTLOAD
Begin DoDot:3
+14 SET ZTSTOP=1
End DoDot:3
QUIT
+15 IF VAUTD=0
DO CHKDIV
IF 'DIVFLAG
QUIT
+16 SET DFN=$PIECE(DGSNODE,"^",1)
+17 ; -- Places card in hold file
+18 SET @DFNARR@(DFN)=""
End DoDot:2
End DoDot:1
HL7 ; -- Builds HL7 batch message
+1 SET DFN=""
+2 FOR
SET DFN=$ORDER(@DFNARR@(DFN))
IF 'DFN
QUIT
SET CNT=CNT+1
+3 SET RESULTS=$$EVENT^DGQEHL72("A08",DFNARR)
+4 IF $DATA(JPTEST)
WRITE !,"Results = ",RESULTS
+5 IF '$DATA(ZTQUEUED)&($PIECE(RESULTS,"^",1)=-1)
Begin DoDot:1
+6 WRITE !,"Scheduled admission data not downloaded. Error - ",$PIECE(RESULTS,"^",2)
End DoDot:1
+7 ; -- Clean up variables
+8 DO EXIT
+9 QUIT
+10 ;
CHKDIV ; -- Check to see if clinic is part of Division selected
+1 ; -- re-sequences array
+2 SET DGSUB=""
FOR DGJ=1:1
SET DGSUB=$ORDER(VAUTD(DGSUB))
IF DGSUB=""
QUIT
SET DGUTD(DGJ)=$GET(VAUTD(DGSUB))
+3 ;
+4 SET DIVFLAG=0
+5 SET DGDV=$PIECE(DGSNODE,"^",12)
+6 IF DGDV=""
SET DIVFLAG=0
QUIT
+7 SET DIVISION=$PIECE($GET(^DG(40.8,DGDV,0)),U,1)
+8 IF DIVISION=""
SET DIVFLAG=0
QUIT
+9 FOR DGJ=1:1
SET SELDIV=DGUTD(DGJ)
Begin DoDot:1
+10 IF SELDIV=DIVISION
SET DIVFLAG=1
QUIT
End DoDot:1
IF '$DATA(DGUTD(DGJ+1))
QUIT
+11 QUIT
+12 ;
BATCH ; -- Batch entry point for placing cards on hold
+1 NEW ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,G
+2 ;
+3 SET ZTRTN="PRESCAN^DGQESC3"
+4 SET ZTDESC="Scheduled admissions download to VIC work station via HL7"
+5 SET ZTIO=""
+6 KILL ZTDTH
+7 ;D NOW^%DTC S ZTDTH=%
+8 FOR G="VAUTD","CNT","DFNARR","SDATE","EDATE"
IF $DATA(@G)
SET ZTSAVE(G)=""
+9 SET ZTSAVE("VAUTD(")=""
+10 DO ^%ZTLOAD
+11 QUIT
+12 ;
END ; -- End of Code
+1 QUIT
+2 ;
