Routine: DVBCNTSC

DVBCNTSC ;ALB ISC/THM-REQUESTS NOT SCHEDULED IN THREE DAYS ; 9/28/91  8:13 AM

 ;;2.7;AMIE;**2,19,193**;Apr 10, 1995;Build 84

;;

 D HOME^%ZIS S (PG,TOTAL)=0

 S Y=DT X ^DD("DD") S DVBCDT(0)=Y D NOW^%DTC S DVBCNOW=% K %

 G EN

PRINT S DTA=^DVB(396.3,DA,0),DFN=$P(DTA,U,1),DTRPT=$P(DTA,U,5)

 ;AJF; Request Status Conversion

 S RQSTAT=$$RSTAT^DVBCUTL8($P(DTA,U,18)),REQCA=$P(DTA,U,19) Q:(RQSTAT["X"!(REQCA'=""))  ;cancelled requests

 S Y=DTRPT X ^DD("DD") S DTRPT2=Y,RO=$P(DTA,U,3),RO=$S($D(^DIC(4,+RO,0)):$P(^(0),U,1),1:"Unknown RO"),DTSCH=$P(DTA,U,6),Y=DTSCH X ^DD("DD") S DTSCH2=Y K DTA

 S DAYS=0 I DTSCH="" S X1=DVBCNOW,X2=DTRPT D ^%DTC Q:X'>3  S DAYS=X

 I DTSCH]"" S X1=DTSCH,X2=DTRPT D ^%DTC Q:X'>3  S DAYS=X

 W PNAM,?33,^TMP($J,RQDT,PNAM,DA),?45,DTRPT2,?69,DTSCH2,?93,RO,?119,DAYS,! S TOTAL=TOTAL+1 I $Y>55 D HDR

EN W @IOF,"2507 Exams Not Scheduled Within Three Days",!!!

 S %DT(0)=-DT,%DT="AE",%DT("A")="Enter STARTING DATE REPORTED TO MAS: " D ^%DT G:Y<0 EXIT S SDATE2=Y,SDATE=Y-.5

 S %DT("A")="    and ENDING DATE REPORTED TO MAS: " D ^%DT G:Y<0 EXIT S EDATE2=Y,EDATE=Y+.2359

 K %DT S HD="2507 Requests Not Scheduled in Three Days at "_$$SITE^DVBCUTL4,HD2="From " S Y=$E(SDATE2,1,7) X ^DD("DD") S HD2=HD2_Y S Y=$E(EDATE2,1,7) X ^DD("DD") S HD2=HD2_" to "_Y

DEV W !! S %ZIS="AEQ" D ^%ZIS G:POP EXIT

 I IOM<132 W *7,!!,"A right margin of 132 is required for this output!",!! G DEV

 I $D(IO("Q")) S ZTIO=ION,ZTRTN="GO^DVBCNTSC",ZTDESC="2507 exams not scheduled in 3 days" F I="TOTAL","PG","SDATE*","EDATE*","HD*","DVBC*" S ZTSAVE(I)=""

 I  D ^%ZTLOAD W:$D(ZTSK) *7,!!,"Request queued.",!! G EXIT

GO K ^TMP($J) ;S X1=SDATE,X2=-7 D C^%DTC S SDATE=X ;allow for last month since using date reported

 U IO D HDR F RQDT=SDATE:0 S RQDT=$O(^DVB(396.3,"C",RQDT)) Q:RQDT=""!(RQDT>EDATE)  F DA=0:0 S DA=$O(^DVB(396.3,"C",RQDT,DA)) Q:DA=""  S X=$P(^DVB(396.3,DA,0),U,5) I X'<SDATE,X'>EDATE D GO1

 S PNAM="" F RQDT=0:0 S RQDT=$O(^TMP($J,RQDT)) Q:RQDT=""  F ZI=0:0 S PNAM=$O(^TMP($J,RQDT,PNAM)) Q:PNAM=""  F DA=0:0 S DA=$O(^TMP($J,RQDT,PNAM,DA)) Q:DA=""  D PRINT

 W !!,"Total requests: ",TOTAL,!!

EXIT D:$D(ZTQUEUED) KILL^%ZTLOAD K DTRPT,DTRPT2,REQCA G KILL^DVBCUTIL

GO1 ;request can be included only if at least one exam wasn't transferred out

 S TFIND=0,COUNT=0

 F XI=0:0 S XI=$O(^DVB(396.4,"C",DA,XI)) Q:XI=""  D

 .S COUNT=COUNT+1

 .I $D(^DVB(396.4,XI,"TRAN")) S TFIND=TFIND+1

 ;if TFIND=COUNT then all exams are transferred, so do not consider for report

 I TFIND<COUNT D

 .S DFN=$P(^DVB(396.3,DA,0),U,1)

 .S NAME=$S($D(^DPT(DFN,0)):$P(^(0),U,1),1:"patient file record missing")

 .S DVBCSSN=$S($D(^DPT(DFN,0)):$P(^(0),U,9),1:"")

 .S ^TMP($J,$E(RQDT,1,7),NAME,DA)=DVBCSSN K DVBCSSN,DFN,NAME

HDR S PG=PG+1 I (IOST?1"C-".E)!(PG>1) W @IOF

 W DVBCDT(0),?(IOM-$L(HD)\2),HD,?(IOM-9),"Page: ",PG,!?(IOM-$L(HD2)\2),HD2,!!!

 W "Veteran name",?33,"SSN",?45,"Date reported-MAS",?69,"Date scheduled",?93,"Requested by",?119,"Days",!

 F LINE=1:1:IOM W "-"

 W !! Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCNTSC   3020     printed  Mar 13, 2025@20:49:47                                                                                                                                                                                                    Page 2

DVBCNTSC  ;ALB ISC/THM-REQUESTS NOT SCHEDULED IN THREE DAYS ; 9/28/91  8:13 AM

 +1       ;;2.7;AMIE;**2,19,193**;Apr 10, 1995;Build 84

 +2       ;;

 +3        DO HOME^%ZIS

           SET (PG,TOTAL)=0

 +4        SET Y=DT

           XECUTE ^DD("DD")

           SET DVBCDT(0)=Y

           DO NOW^%DTC

           SET DVBCNOW=%

           KILL %

 +5        GOTO EN

 +6       ;

PRINT      SET DTA=^DVB(396.3,DA,0)

           SET DFN=$PIECE(DTA,U,1)

           SET DTRPT=$PIECE(DTA,U,5)

 +1       ;AJF; Request Status Conversion

 +2       ;cancelled requests

           SET RQSTAT=$$RSTAT^DVBCUTL8($PIECE(DTA,U,18))

           SET REQCA=$PIECE(DTA,U,19)

           if (RQSTAT["X"!(REQCA'=""))

               QUIT

 +3        SET Y=DTRPT

           XECUTE ^DD("DD")

           SET DTRPT2=Y

           SET RO=$PIECE(DTA,U,3)

           SET RO=$SELECT($DATA(^DIC(4,+RO,0)):$PIECE(^(0),U,1),1:"Unknown RO")

           SET DTSCH=$PIECE(DTA,U,6)

           SET Y=DTSCH

           XECUTE ^DD("DD")

           SET DTSCH2=Y

           KILL DTA

 +4        SET DAYS=0

           IF DTSCH=""

               SET X1=DVBCNOW

               SET X2=DTRPT

               DO ^%DTC

               if X'>3

                   QUIT

               SET DAYS=X

 +5        IF DTSCH]""

               SET X1=DTSCH

               SET X2=DTRPT

               DO ^%DTC

               if X'>3

                   QUIT

               SET DAYS=X

 +6        WRITE PNAM,?33,^TMP($JOB,RQDT,PNAM,DA),?45,DTRPT2,?69,DTSCH2,?93,RO,?119,DAYS,!

           SET TOTAL=TOTAL+1

           IF $Y>55

               DO HDR

 +7        QUIT

 +8       ;

EN         WRITE @IOF,"2507 Exams Not Scheduled Within Three Days",!!!

 +1        SET %DT(0)=-DT

           SET %DT="AE"

           SET %DT("A")="Enter STARTING DATE REPORTED TO MAS: "

           DO ^%DT

           if Y<0

               GOTO EXIT

           SET SDATE2=Y

           SET SDATE=Y-.5

 +2        SET %DT("A")="    and ENDING DATE REPORTED TO MAS: "

           DO ^%DT

           if Y<0

               GOTO EXIT

           SET EDATE2=Y

           SET EDATE=Y+.2359

 +3        KILL %DT

           SET HD="2507 Requests Not Scheduled in Three Days at "_$$SITE^DVBCUTL4

           SET HD2="From "

           SET Y=$EXTRACT(SDATE2,1,7)

           XECUTE ^DD("DD")

           SET HD2=HD2_Y

           SET Y=$EXTRACT(EDATE2,1,7)

           XECUTE ^DD("DD")

           SET HD2=HD2_" to "_Y

 +4       ;

DEV        WRITE !!

           SET %ZIS="AEQ"

           DO ^%ZIS

           if POP

               GOTO EXIT

 +1        IF IOM<132

               WRITE *7,!!,"A right margin of 132 is required for this output!",!!

               GOTO DEV

 +2        IF $DATA(IO("Q"))

               SET ZTIO=ION

               SET ZTRTN="GO^DVBCNTSC"

               SET ZTDESC="2507 exams not scheduled in 3 days"

               FOR I="TOTAL","PG","SDATE*","EDATE*","HD*","DVBC*"

                   SET ZTSAVE(I)=""

 +3       IF $TEST

               DO ^%ZTLOAD

               if $DATA(ZTSK)

                   WRITE *7,!!,"Request queued.",!!

               GOTO EXIT

 +4       ;

GO        ;S X1=SDATE,X2=-7 D C^%DTC S SDATE=X ;allow for last month since using date reported

           KILL ^TMP($JOB)

 +1        USE IO

           DO HDR

           FOR RQDT=SDATE:0

               SET RQDT=$ORDER(^DVB(396.3,"C",RQDT))

               if RQDT=""!(RQDT>EDATE)

                   QUIT

               FOR DA=0:0

                   SET DA=$ORDER(^DVB(396.3,"C",RQDT,DA))

                   if DA=""

                       QUIT

                   SET X=$PIECE(^DVB(396.3,DA,0),U,5)

                   IF X'<SDATE

                       IF X'>EDATE

                           DO GO1

 +2        SET PNAM=""

           FOR RQDT=0:0

               SET RQDT=$ORDER(^TMP($JOB,RQDT))

               if RQDT=""

                   QUIT

               FOR ZI=0:0

                   SET PNAM=$ORDER(^TMP($JOB,RQDT,PNAM))

                   if PNAM=""

                       QUIT

                   FOR DA=0:0

                       SET DA=$ORDER(^TMP($JOB,RQDT,PNAM,DA))

                       if DA=""

                           QUIT

                       DO PRINT

 +3        WRITE !!,"Total requests: ",TOTAL,!!

 +4       ;

EXIT       if $DATA(ZTQUEUED)

               DO KILL^%ZTLOAD

           KILL DTRPT,DTRPT2,REQCA

           GOTO KILL^DVBCUTIL

 +1       ;

GO1       ;request can be included only if at least one exam wasn't transferred out

 +1        SET TFIND=0

           SET COUNT=0

 +2        FOR XI=0:0

               SET XI=$ORDER(^DVB(396.4,"C",DA,XI))

               if XI=""

                   QUIT

               Begin DoDot:1

 +3                SET COUNT=COUNT+1

 +4                IF $DATA(^DVB(396.4,XI,"TRAN"))

                       SET TFIND=TFIND+1

               End DoDot:1

 +5       ;if TFIND=COUNT then all exams are transferred, so do not consider for report

 +6        IF TFIND<COUNT

               Begin DoDot:1

 +7                SET DFN=$PIECE(^DVB(396.3,DA,0),U,1)

 +8                SET NAME=$SELECT($DATA(^DPT(DFN,0)):$PIECE(^(0),U,1),1:"patient file record missing")

 +9                SET DVBCSSN=$SELECT($DATA(^DPT(DFN,0)):$PIECE(^(0),U,9),1:"")

 +10               SET ^TMP($JOB,$EXTRACT(RQDT,1,7),NAME,DA)=DVBCSSN

                   KILL DVBCSSN,DFN,NAME

               End DoDot:1

 +11       QUIT

 +12      ;

HDR        SET PG=PG+1

           IF (IOST?1"C-".E)!(PG>1)

               WRITE @IOF

 +1        WRITE DVBCDT(0),?(IOM-$LENGTH(HD)\2),HD,?(IOM-9),"Page: ",PG,!?(IOM-$LENGTH(HD2)\2),HD2,!!!

 +2        WRITE "Veteran name",?33,"SSN",?45,"Date reported-MAS",?69,"Date scheduled",?93,"Requested by",?119,"Days",!

 +3        FOR LINE=1:1:IOM

               WRITE "-"

 +4        WRITE !!

           QUIT

DVBCNTSC.m