DGQESC2 ;ALB/JFP - VIC OUTPATIENT CLINIC SCAN ROUTINE ; 03/29/2004
;;5.3;Registration;**73,568,725,1015**;Aug 13, 1993;Build 21
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
ENO ; -- Entry Point
N DIR,Y
;
S DIR(0)="YA"
S DIR("A")="Download Clinics patients 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,VAUTNI,VAUTC
.N DATE,DFNARR,CNT,Y,ERR,SDATE,EDATE,DFN,RESULTS
.N DIVFLAG,DIVISION,SELDIV
.N DGSUB,DGJ,DGUTD,DGWD,DGDV,ZTSTOP
.; -- 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
.; -- Check for Clinics within division or all
.S VAUTNI=2
.D CLINIC^VAUTOMA
.I Y=-1 Q
.; -- 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
.S DIR(0)="YA"
.; -- Task off job
.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 OUTSCAN
Q
;
EXIT ; -- Finish Process
I '$D(ZTQUEUED)&($P(RESULTS,"^",1)=0) W !!,CNT_" Outpatients down loaded to VIC work station"
K @DFNARR
Q
;
OUTSCAN ; Scan the clinics for appointments to create VIC cards
;
N CLINIC,CLINDATE,DPTINFO,I,CLNARRAY,DGARRAY,DGDIV,SDCNT S I=1
K ^TMP($J,"SDAMA"),^TMP($J,"SDAMA301")
;
I '$D(ZTQUEUED) W !!,"Note: Each Dot equals a clinic",!
I VAUTC,VAUTD D
.S CLINIC=0 F S CLINIC=$O(^SC(CLINIC)) Q:'CLINIC D
..I $P(^SC(CLINIC,0),U,3)="C" D CBLD3(CLINIC)
;
I VAUTC,'VAUTD S DGDIV="" D
.S DGDIV="" F S DGDIV=$O(VAUTD(DGDIV)) Q:'DGDIV D
..S CLINIC=0 F S CLINIC=$O(^SC(CLINIC)) Q:'CLINIC D
...I $P(^SC(CLINIC,0),U,3)="C",$P(^SC(CLINIC,0),U,15)=DGDIV D CBLD3(CLINIC)
;
I 'VAUTC S CLINIC=0 F S CLINIC=$O(VAUTC(CLINIC)) Q:'CLINIC D CBLD3(CLINIC)
;
D SDAMA,BLDTMP,BLDHL7
K DGARRAY,SDCNT,^TMP($J,"SDAMA301"),^TMP($J,"SDAMA")
Q
CBLD3(CLINIC) ; Build array of specified Clinics for specified Divisions
S CLNARRAY(I)=$G(CLNARRAY(I))_CLINIC_";"
I $L(CLNARRAY(I))>120 S I=I+1
I '$D(ZTQUEUED) W "."
Q
;
SDAMA ; Build TMP Global with Appointment API Data for Report
S DGARRAY(1)=SDATE_";"_EDATE
S DGARRAY("FLDS")="2;3"
F I=1:1 Q:'$D(CLNARRAY(I)) D
.S DGARRAY(2)=CLNARRAY(I)
.I $$SDAPI^SDAMA301(.DGARRAY)>0 M ^TMP($J,"SDAMA")=^TMP($J,"SDAMA301")
.K ^TMP($J,"SDAMA301")
Q
BLDHL7 ; -- Building 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 !,"Clinic patients not downloaded. Error - ",$P(RESULTS,"^",2)
; -- Clean up variables
D EXIT
Q
;
BLDTMP ;
; -- Building Temporary Storage Data
S (ZTSTOP,CLINIC)=0 F S CLINIC=$O(^TMP($J,"SDAMA",CLINIC)) Q:'CLINIC!(ZTSTOP) D
.I $$S^%ZTLOAD S ZTSTOP=1 Q
.S DFN=0 F S DFN=$O(^TMP($J,"SDAMA",CLINIC,DFN)) Q:'DFN D
..S CLINDATE=0 F S CLINDATE=$O(^TMP($J,"SDAMA",CLINIC,DFN,CLINDATE)) Q:'CLINDATE D
...I $P($P(^TMP($J,"SDAMA",CLINIC,DFN,CLINDATE),U,3),";")="R" S @DFNARR@(DFN)=""
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=CLINIC
I DGWD S DGDV=$S('$D(^SC(DGWD,0)):0,+$P(^(0),"^",15):$P(^(0),"^",15),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,ZTDESC,ZTIO,ZTDTH,ZTSAVE,G
;
S ZTRTN="OUTSCAN^DGQESC2"
S ZTDESC="Download Outpatients to VIC work station via HL7"
S ZTIO=""
K ZTDTH
;D NOW^%DTC S ZTDTH=%
F G="VAUTD","VAUTC","CNT","DFNARR","SDATE","EDATE" S:$D(@G) ZTSAVE(G)=""
S ZTSAVE("VAUTD(")="",ZTSAVE("VAUTC(")=""
D ^%ZTLOAD
Q
;
END ; -- End of Code
Q
;
DGQESC2 ;ALB/JFP - VIC OUTPATIENT CLINIC SCAN ROUTINE ; 03/29/2004
+1 ;;5.3;Registration;**73,568,725,1015**;Aug 13, 1993;Build 21
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
ENO ; -- Entry Point
+1 NEW DIR,Y
+2 ;
+3 SET DIR(0)="YA"
+4 SET DIR("A")="Download Clinics patients 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,VAUTNI,VAUTC
+11 NEW DATE,DFNARR,CNT,Y,ERR,SDATE,EDATE,DFN,RESULTS
+12 NEW DIVFLAG,DIVISION,SELDIV
+13 NEW DGSUB,DGJ,DGUTD,DGWD,DGDV,ZTSTOP
+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 ; -- Check for Clinics within division or all
+24 SET VAUTNI=2
+25 DO CLINIC^VAUTOMA
+26 IF Y=-1
QUIT
+27 ; -- Download for date range
+28 SET ERR=$$SDATE^DGQESC0()
+29 IF ERR=-1
QUIT
+30 SET SDATE=ERR
+31 SET ERR=$$EDATE^DGQESC0(ERR)
+32 IF ERR=-1
QUIT
+33 SET EDATE=ERR
+34 SET DIR(0)="YA"
+35 ; -- Task off job
+36 SET DIR("A")="Task job: "
+37 SET DIR("B")="YES"
+38 SET DIR("?")="Enter YES/NO to determine whether job is tasked"
+39 DO ^DIR
+40 IF $DATA(DIRUT)
QUIT
+41 IF Y
Begin DoDot:2
+42 DO BATCH
+43 IF '$DATA(ZTSK)
QUIT
+44 WRITE !,"Card(s) queued, task number = "_ZTSK
End DoDot:2
QUIT
+45 DO OUTSCAN
End DoDot:1
QUIT
+46 QUIT
+47 ;
EXIT ; -- Finish Process
+1 IF '$DATA(ZTQUEUED)&($PIECE(RESULTS,"^",1)=0)
WRITE !!,CNT_" Outpatients down loaded to VIC work station"
+2 KILL @DFNARR
+3 QUIT
+4 ;
OUTSCAN ; Scan the clinics for appointments to create VIC cards
+1 ;
+2 NEW CLINIC,CLINDATE,DPTINFO,I,CLNARRAY,DGARRAY,DGDIV,SDCNT
SET I=1
+3 KILL ^TMP($JOB,"SDAMA"),^TMP($JOB,"SDAMA301")
+4 ;
+5 IF '$DATA(ZTQUEUED)
WRITE !!,"Note: Each Dot equals a clinic",!
+6 IF VAUTC
IF VAUTD
Begin DoDot:1
+7 SET CLINIC=0
FOR
SET CLINIC=$ORDER(^SC(CLINIC))
IF 'CLINIC
QUIT
Begin DoDot:2
+8 IF $PIECE(^SC(CLINIC,0),U,3)="C"
DO CBLD3(CLINIC)
End DoDot:2
End DoDot:1
+9 ;
+10 IF VAUTC
IF 'VAUTD
SET DGDIV=""
Begin DoDot:1
+11 SET DGDIV=""
FOR
SET DGDIV=$ORDER(VAUTD(DGDIV))
IF 'DGDIV
QUIT
Begin DoDot:2
+12 SET CLINIC=0
FOR
SET CLINIC=$ORDER(^SC(CLINIC))
IF 'CLINIC
QUIT
Begin DoDot:3
+13 IF $PIECE(^SC(CLINIC,0),U,3)="C"
IF $PIECE(^SC(CLINIC,0),U,15)=DGDIV
DO CBLD3(CLINIC)
End DoDot:3
End DoDot:2
End DoDot:1
+14 ;
+15 IF 'VAUTC
SET CLINIC=0
FOR
SET CLINIC=$ORDER(VAUTC(CLINIC))
IF 'CLINIC
QUIT
DO CBLD3(CLINIC)
+16 ;
+17 DO SDAMA
DO BLDTMP
DO BLDHL7
+18 KILL DGARRAY,SDCNT,^TMP($JOB,"SDAMA301"),^TMP($JOB,"SDAMA")
+19 QUIT
CBLD3(CLINIC) ; Build array of specified Clinics for specified Divisions
+1 SET CLNARRAY(I)=$GET(CLNARRAY(I))_CLINIC_";"
+2 IF $LENGTH(CLNARRAY(I))>120
SET I=I+1
+3 IF '$DATA(ZTQUEUED)
WRITE "."
+4 QUIT
+5 ;
SDAMA ; Build TMP Global with Appointment API Data for Report
+1 SET DGARRAY(1)=SDATE_";"_EDATE
+2 SET DGARRAY("FLDS")="2;3"
+3 FOR I=1:1
IF '$DATA(CLNARRAY(I))
QUIT
Begin DoDot:1
+4 SET DGARRAY(2)=CLNARRAY(I)
+5 IF $$SDAPI^SDAMA301(.DGARRAY)>0
MERGE ^TMP($JOB,"SDAMA")=^TMP($JOB,"SDAMA301")
+6 KILL ^TMP($JOB,"SDAMA301")
End DoDot:1
+7 QUIT
BLDHL7 ; -- Building 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 !,"Clinic patients not downloaded. Error - ",$PIECE(RESULTS,"^",2)
End DoDot:1
+6 ; -- Clean up variables
+7 DO EXIT
+8 QUIT
+9 ;
BLDTMP ;
+1 ; -- Building Temporary Storage Data
+2 SET (ZTSTOP,CLINIC)=0
FOR
SET CLINIC=$ORDER(^TMP($JOB,"SDAMA",CLINIC))
IF 'CLINIC!(ZTSTOP)
QUIT
Begin DoDot:1
+3 IF $$S^%ZTLOAD
SET ZTSTOP=1
QUIT
+4 SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"SDAMA",CLINIC,DFN))
IF 'DFN
QUIT
Begin DoDot:2
+5 SET CLINDATE=0
FOR
SET CLINDATE=$ORDER(^TMP($JOB,"SDAMA",CLINIC,DFN,CLINDATE))
IF 'CLINDATE
QUIT
Begin DoDot:3
+6 IF $PIECE($PIECE(^TMP($JOB,"SDAMA",CLINIC,DFN,CLINDATE),U,3),";")="R"
SET @DFNARR@(DFN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
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=CLINIC
+6 IF DGWD
SET DGDV=$SELECT('$DATA(^SC(DGWD,0)):0,+$PIECE(^(0),"^",15):$PIECE(^(0),"^",15),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,ZTDESC,ZTIO,ZTDTH,ZTSAVE,G
+2 ;
+3 SET ZTRTN="OUTSCAN^DGQESC2"
+4 SET ZTDESC="Download Outpatients to VIC work station via HL7"
+5 SET ZTIO=""
+6 KILL ZTDTH
+7 ;D NOW^%DTC S ZTDTH=%
+8 FOR G="VAUTD","VAUTC","CNT","DFNARR","SDATE","EDATE"
IF $DATA(@G)
SET ZTSAVE(G)=""
+9 SET ZTSAVE("VAUTD(")=""
SET ZTSAVE("VAUTC(")=""
+10 DO ^%ZTLOAD
+11 QUIT
+12 ;
END ; -- End of Code
+1 QUIT
+2 ;
