DGQESC2.m

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       ;