DGQESC1 ;ALB/JFP - VIC INPATIENT 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.
;
ENI ; -- Entry Point
N DIR,Y
S DIR(0)="YA"
S DIR("A")="Download all current Inpatients to the VIC card station "
S DIR("B")="NO"
S DIR("?")="Enter yes to download data."
D ^DIR
I Y D Q
.; -- New varaibles
.N DATE,DFNARR,CLINIC,DFN,ZTSTOP,CNT,RESULTS
.N VAUTD,VAUTNI
.N DGSUB,DGJ,DGUTP,DGWD,DGDV
.N DIVFLAG,DIVISION,SELDIV
.; -- Set variables
.S VAUTD=1 ; -- All divisions selected
.S CNT=0
.D NOW^%DTC S DATE=%
.S DFNARR="^TMP(""DGQE-DFN"","_$J_")"
.K @DFNARR
.; -- Check for multi divisional hospital
.I $P(^DG(43,1,"GL"),"^",2)=1 D Q:Y=-1
..D DIVISION^VAUTOMA
.; -- Check for wards within division or all
.S VAUTNI=2
.D WARD^VAUTOMA
.I Y=-1 Q
.; -- Task off job
.S DIR(0)="YA"
.S DIR("A")="Queue job: "
.S DIR("B")="YES"
.S DIR("?")="Enter YES or NO to have job run in background"
.D ^DIR
.Q:$D(DIRUT)
.I Y D Q
..D BATCH
..I '$D(ZTSK) Q
..W !,"Card(s) queued, task number = "_ZTSK
.; -- Builds an array of inpatients to download
.D INSCAN
Q
;
EXIT ; -- Finish processing
I '$D(ZTQUEUED)&($P(RESULTS,"^",1)=0) W !!,CNT_" Inpatients down loaded to VIC work station"
K @DFNARR
Q
;
INSCAN ; -- Scans all ward locations for inpatients
I '$D(ZTQUEUED) W !!,"Note: Each dot equals a ward",!,"."
; -- scan INPATIENT clinics
S (CLINIC,DFN)=""
F S CLINIC=$O(^DPT("CN",CLINIC)) Q:(CLINIC="") D
.; -- Check to see if users wants task to stop
.I $$S^%ZTLOAD D Q
..S ZTSTOP=1
.I VAUTD=0 D CHKDIV Q:'DIVFLAG
.I '$D(ZTQUEUED) W "."
.S DFN=""
.F S DFN=$O(^DPT("CN",CLINIC,DFN)) Q:(DFN="") D
..;W !,"DFN = ",DFN
..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(ZTQUEUED)&($P(RESULTS,"^",1)=-1) D
.W !,"Inpatient 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 DGWD=$O(^DIC(42,"B",CLINIC,0))
I DGWD S DGDV=$S('$D(^DIC(42,DGWD,0)):0,+$P(^(0),"^",11):$P(^(0),"^",11),1:$O(^DG(40.8,0)))
I DGDV=0 S DIVFLAG=0 Q
S DIVISION=$P($G(^DG(40.8,DGDV,0)),U,1)
I DIVISION="" S DIVFLAG=0 Q
;W !,"DIVISION = ",DIVISION
F DGJ=1:1 S SELDIV=DGUTD(DGJ) D Q:'$D(DGUTD(DGJ+1))
.;W !,"SELDIV = ",SELDIV
.I SELDIV=DIVISION S DIVFLAG=1 Q
Q
;
BATCH ; -- Entry point for placing cards on hold
N ZTRTN,ZTDESCO,ZTIO,ZTDTH,ZTSAVE,G
;
S ZTRTN="INSCAN^DGQESC1"
S ZTDESC="Download Inpatients to VIC work station via HL7"
S ZTIO=""
K ZTDTH
;D NOW^%DTC S ZTDTH=%
F G="VAUTD","DFNARR","CNT" S:$D(@G) ZTSAVE(G)=""
S ZTSAVE("VAUTD(")=""
D ^%ZTLOAD
Q
;
END ; -- End of Code
Q
;
DGQESC1 ;ALB/JFP - VIC INPATIENT 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 ;
ENI ; -- Entry Point
+1 NEW DIR,Y
+2 SET DIR(0)="YA"
+3 SET DIR("A")="Download all current Inpatients to the VIC card station "
+4 SET DIR("B")="NO"
+5 SET DIR("?")="Enter yes to download data."
+6 DO ^DIR
+7 IF Y
Begin DoDot:1
+8 ; -- New varaibles
+9 NEW DATE,DFNARR,CLINIC,DFN,ZTSTOP,CNT,RESULTS
+10 NEW VAUTD,VAUTNI
+11 NEW DGSUB,DGJ,DGUTP,DGWD,DGDV
+12 NEW DIVFLAG,DIVISION,SELDIV
+13 ; -- Set variables
+14 ; -- All divisions selected
SET VAUTD=1
+15 SET CNT=0
+16 DO NOW^%DTC
SET DATE=%
+17 SET DFNARR="^TMP(""DGQE-DFN"","_$JOB_")"
+18 KILL @DFNARR
+19 ; -- Check for multi divisional hospital
+20 IF $PIECE(^DG(43,1,"GL"),"^",2)=1
Begin DoDot:2
+21 DO DIVISION^VAUTOMA
End DoDot:2
IF Y=-1
QUIT
+22 ; -- Check for wards within division or all
+23 SET VAUTNI=2
+24 DO WARD^VAUTOMA
+25 IF Y=-1
QUIT
+26 ; -- Task off job
+27 SET DIR(0)="YA"
+28 SET DIR("A")="Queue job: "
+29 SET DIR("B")="YES"
+30 SET DIR("?")="Enter YES or NO to have job run in background"
+31 DO ^DIR
+32 IF $DATA(DIRUT)
QUIT
+33 IF Y
Begin DoDot:2
+34 DO BATCH
+35 IF '$DATA(ZTSK)
QUIT
+36 WRITE !,"Card(s) queued, task number = "_ZTSK
End DoDot:2
QUIT
+37 ; -- Builds an array of inpatients to download
+38 DO INSCAN
End DoDot:1
QUIT
+39 QUIT
+40 ;
EXIT ; -- Finish processing
+1 IF '$DATA(ZTQUEUED)&($PIECE(RESULTS,"^",1)=0)
WRITE !!,CNT_" Inpatients down loaded to VIC work station"
+2 KILL @DFNARR
+3 QUIT
+4 ;
INSCAN ; -- Scans all ward locations for inpatients
+1 IF '$DATA(ZTQUEUED)
WRITE !!,"Note: Each dot equals a ward",!,"."
+2 ; -- scan INPATIENT clinics
+3 SET (CLINIC,DFN)=""
+4 FOR
SET CLINIC=$ORDER(^DPT("CN",CLINIC))
IF (CLINIC="")
QUIT
Begin DoDot:1
+5 ; -- Check to see if users wants task to stop
+6 IF $$S^%ZTLOAD
Begin DoDot:2
+7 SET ZTSTOP=1
End DoDot:2
QUIT
+8 IF VAUTD=0
DO CHKDIV
IF 'DIVFLAG
QUIT
+9 IF '$DATA(ZTQUEUED)
WRITE "."
+10 SET DFN=""
+11 FOR
SET DFN=$ORDER(^DPT("CN",CLINIC,DFN))
IF (DFN="")
QUIT
Begin DoDot:2
+12 ;W !,"DFN = ",DFN
+13 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(ZTQUEUED)&($PIECE(RESULTS,"^",1)=-1)
Begin DoDot:1
+5 WRITE !,"Inpatient data not downloaded. Error - ",$PIECE(RESULTS,"^",2)
End DoDot:1
+6 ; -- Clean up variables
+7 DO EXIT
+8 QUIT
+9 ;
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 DGWD=$ORDER(^DIC(42,"B",CLINIC,0))
+6 IF DGWD
SET DGDV=$SELECT('$DATA(^DIC(42,DGWD,0)):0,+$PIECE(^(0),"^",11):$PIECE(^(0),"^",11),1:$ORDER(^DG(40.8,0)))
+7 IF DGDV=0
SET DIVFLAG=0
QUIT
+8 SET DIVISION=$PIECE($GET(^DG(40.8,DGDV,0)),U,1)
+9 IF DIVISION=""
SET DIVFLAG=0
QUIT
+10 ;W !,"DIVISION = ",DIVISION
+11 FOR DGJ=1:1
SET SELDIV=DGUTD(DGJ)
Begin DoDot:1
+12 ;W !,"SELDIV = ",SELDIV
+13 IF SELDIV=DIVISION
SET DIVFLAG=1
QUIT
End DoDot:1
IF '$DATA(DGUTD(DGJ+1))
QUIT
+14 QUIT
+15 ;
BATCH ; -- Entry point for placing cards on hold
+1 NEW ZTRTN,ZTDESCO,ZTIO,ZTDTH,ZTSAVE,G
+2 ;
+3 SET ZTRTN="INSCAN^DGQESC1"
+4 SET ZTDESC="Download Inpatients to VIC work station via HL7"
+5 SET ZTIO=""
+6 KILL ZTDTH
+7 ;D NOW^%DTC S ZTDTH=%
+8 FOR G="VAUTD","DFNARR","CNT"
IF $DATA(@G)
SET ZTSAVE(G)=""
+9 SET ZTSAVE("VAUTD(")=""
+10 DO ^%ZTLOAD
+11 QUIT
+12 ;
END ; -- End of Code
+1 QUIT
+2 ;
