source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCNTSC.m@ 813

Last change on this file since 813 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1DVBCNTSC ;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 ;
8PRINT 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 ;
15EN 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 ;
20DEV 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 ;
25GO 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 ;
30EXIT D:$D(ZTQUEUED) KILL^%ZTLOAD K DTRPT,DTRPT2,REQCA G KILL^DVBCUTIL
31 ;
32GO1 ;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 ;
45HDR 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
Note: See TracBrowser for help on using the repository browser.