113 lines
3.0 KiB
Mathematica
113 lines
3.0 KiB
Mathematica
|
DGQESC3 ;ALB/JFP - VIC PREADMIT SCAN ROUTINE ; 01/09/96
|
||
|
|
;;V5.3;REGISTRATION;**73**;DEC 11,1996
|
||
|
|
;;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
|
||
|
|
;
|