| [613] | 1 | DVBCNTSC ;ALB ISC/THM-REQUESTS NOT SCHEDULED IN THREE DAYS ; 9/28/91 8:13 AM
|
|---|
| 2 | ;;2.7;AMIE;**2,19**;Apr 10, 1995
|
|---|
| 3 | ;;
|
|---|
| 4 | D HOME^%ZIS S (PG,TOTAL)=0
|
|---|
| 5 | S Y=DT X ^DD("DD") S DVBCDT(0)=Y D NOW^%DTC S DVBCNOW=% K %
|
|---|
| 6 | G EN
|
|---|
| 7 | ;
|
|---|
| 8 | PRINT S DTA=^DVB(396.3,DA,0),DFN=$P(DTA,U,1),DTRPT=$P(DTA,U,5),RQSTAT=$P(DTA,U,18),REQCA=$P(DTA,U,19) Q:(RQSTAT["X"!(REQCA'="")) ;cancelled requests
|
|---|
| 9 | 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
|
|---|
| 10 | S DAYS=0 I DTSCH="" S X1=DVBCNOW,X2=DTRPT D ^%DTC Q:X'>3 S DAYS=X
|
|---|
| 11 | I DTSCH]"" S X1=DTSCH,X2=DTRPT D ^%DTC Q:X'>3 S DAYS=X
|
|---|
| 12 | 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
|
|---|
| 13 | Q
|
|---|
| 14 | ;
|
|---|
| 15 | EN W @IOF,"2507 Exams Not Scheduled Within Three Days",!!!
|
|---|
| 16 | 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
|
|---|
| 17 | S %DT("A")=" and ENDING DATE REPORTED TO MAS: " D ^%DT G:Y<0 EXIT S EDATE2=Y,EDATE=Y+.2359
|
|---|
| 18 | 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
|
|---|
| 19 | ;
|
|---|
| 20 | DEV W !! S %ZIS="AEQ" D ^%ZIS G:POP EXIT
|
|---|
| 21 | I IOM<132 W *7,!!,"A right margin of 132 is required for this output!",!! G DEV
|
|---|
| 22 | 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)=""
|
|---|
| 23 | I D ^%ZTLOAD W:$D(ZTSK) *7,!!,"Request queued.",!! G EXIT
|
|---|
| 24 | ;
|
|---|
| 25 | GO K ^TMP($J) ;S X1=SDATE,X2=-7 D C^%DTC S SDATE=X ;allow for last month since using date reported
|
|---|
| 26 | 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
|
|---|
| 27 | 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
|
|---|
| 28 | W !!,"Total requests: ",TOTAL,!!
|
|---|
| 29 | ;
|
|---|
| 30 | EXIT D:$D(ZTQUEUED) KILL^%ZTLOAD K DTRPT,DTRPT2,REQCA G KILL^DVBCUTIL
|
|---|
| 31 | ;
|
|---|
| 32 | GO1 ;request can be included only if at least one exam wasn't transferred out
|
|---|
| 33 | S TFIND=0,COUNT=0
|
|---|
| 34 | F XI=0:0 S XI=$O(^DVB(396.4,"C",DA,XI)) Q:XI="" D
|
|---|
| 35 | .S COUNT=COUNT+1
|
|---|
| 36 | .I $D(^DVB(396.4,XI,"TRAN")) S TFIND=TFIND+1
|
|---|
| 37 | ;if TFIND=COUNT then all exams are transferred, so do not consider for report
|
|---|
| 38 | I TFIND<COUNT D
|
|---|
| 39 | .S DFN=$P(^DVB(396.3,DA,0),U,1)
|
|---|
| 40 | .S NAME=$S($D(^DPT(DFN,0)):$P(^(0),U,1),1:"patient file record missing")
|
|---|
| 41 | .S DVBCSSN=$S($D(^DPT(DFN,0)):$P(^(0),U,9),1:"")
|
|---|
| 42 | .S ^TMP($J,$E(RQDT,1,7),NAME,DA)=DVBCSSN K DVBCSSN,DFN,NAME
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | HDR S PG=PG+1 I (IOST?1"C-".E)!(PG>1) W @IOF
|
|---|
| 46 | W DVBCDT(0),?(IOM-$L(HD)\2),HD,?(IOM-9),"Page: ",PG,!?(IOM-$L(HD2)\2),HD2,!!!
|
|---|
| 47 | W "Veteran name",?33,"SSN",?45,"Date reported-MAS",?69,"Date scheduled",?93,"Requested by",?119,"Days",!
|
|---|
| 48 | F LINE=1:1:IOM W "-"
|
|---|
| 49 | W !! Q
|
|---|
