| 1 | DVBAB2 ;ALB/KLB - CAPRI RO AMIS REPORT CONT. ;05/01/00
|
|---|
| 2 | ;;2.7;AMIE;**35,42**;Apr 10, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | DAY30 K ^TMP("DVBC",$J)
|
|---|
| 5 | F FA=DTRPT-.1:0 S FA=$O(^DPT(PNAM,"S",FA)) Q:FA=""!(FA>EDATE) I $D(^(FA,0)) S L=^(0),C=+L S YY=$P(L,U,2) I YY'="N"&(YY'="C")&(YY'="NA")&(YY'="CA")&(YY'="PC")&(YY'="PCA") I FA'>EDATE S ^TMP("DVBC",$J,9999999-FA,FA)=""
|
|---|
| 6 | Q:'$D(^TMP("DVBC",$J)) S FB=$O(^TMP("DVBC",$J,0)),FA=$O(^TMP("DVBC",$J,FB,0)) I FA]"" S X2=FA,X1=$S(DTSCHEDC]"":DTSCHEDC,1:DVBCNOW) D ^%DTC I X>30 S TOT("30DAYEX")=TOT("30DAYEX")+1
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | PENDCNT I X'<0&(X'>90) S TOT("P90")=TOT("P90")+1
|
|---|
| 10 | I X>90&(X'>120) S TOT("P121")=TOT("P121")+1
|
|---|
| 11 | I X>120&(X'>150) S TOT("P151")=TOT("P151")+1
|
|---|
| 12 | I X>150&(X'>180) S TOT("P181")=TOT("P181")+1
|
|---|
| 13 | I X>180&(X'>365) S TOT("P365")=TOT("P365")+1
|
|---|
| 14 | I X>365 S TOT("P366")=TOT("P366")+1
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | SET S DTA=^DVB(396.3,REQDA,0),DTREQ=$P(DTA,U,2),XRONUM=$P(DTA,U,3),XRONUM=$S($D(^DIC(4,+XRONUM,99)):$P(^(99),U,1),1:0) Q:XRONUM'=RONUM&(RONUM'="ALL")
|
|---|
| 18 | ; Next 2 lines check for specific division SPH/ALB - 9/3/02
|
|---|
| 19 | I DVBDIV'="" I '$D(^DVB(396.3,REQDA,1)) Q
|
|---|
| 20 | I DVBDIV'="" I $P(^DVB(396.3,REQDA,1),"^",4)'=DVBDIV Q
|
|---|
| 21 | K XRONUM S DTRPT=$P(DTA,U,5),DTSCHEDC=$P(DTA,U,6),DTRQCMP=$P(DTA,U,7),DTTRANS=$P(DTA,U,12),DTREL=$P(DTA,U,14),RQSTAT=$P(DTA,U,18),DTCAN=$P(DTA,U,19),PRIO=$P(DTA,U,10) K DTA
|
|---|
| 22 | I DTRPT="",DTCAN]"" S DTRPT=DTCAN
|
|---|
| 23 | Q:DTRPT="" ;requests never printed
|
|---|
| 24 | I DTREL'<BDATE,DTREL'>EDATE D DAY30
|
|---|
| 25 | I DTRPT'<BDATE,DTRPT'>EDATE S TOT("SENT")=TOT("SENT")+1
|
|---|
| 26 | I DTRPT'<BDATE,DTRPT'>EDATE,RQSTAT'["X" S X1=$S(DTSCHEDC]"":DTSCHEDC,1:DVBCNOW),X2=DTRPT D ^%DTC I X>3 S TOT("3DAYSCH")=TOT("3DAYSCH")+1
|
|---|
| 27 | I DTREL'<BDATE&(DTREL'>EDATE),RQSTAT="C"!(RQSTAT="R") S:PRIO'="E" DVBCPCTM=$$PROCDAY^DVBCUTL2(REQDA) S:PRIO="E" DVBCPCTM=$$INSFTME^DVBCUTA1(REQDA) S TOT("DAYS")=TOT("DAYS")+DVBCPCTM K DVBCPCTM
|
|---|
| 28 | I DTRPT'>EDATE,"^P^S^T"[RQSTAT S TOT("PENDADJ")=TOT("PENDADJ")+1,X1=EDATE,X2=DTRPT D ^%DTC,PENDCNT
|
|---|
| 29 | I DTRPT'>EDATE,"^C^CT^R^RX^X^"[RQSTAT,(+DTREL>EDATE)!(+DTCAN>EDATE) S TOT("PENDADJ")=TOT("PENDADJ")+1,X1=EDATE,X2=DTRPT D ^%DTC,PENDCNT
|
|---|
| 30 | I DTREL'<BDATE&(DTREL'>EDATE),RQSTAT["C"!(RQSTAT="R") S TOT("COMPLETED")=TOT("COMPLETED")+1
|
|---|
| 31 | I DTRPT'<BDATE,DTRPT'>EDATE,PRIO="E" S TOT("INSUFF")=TOT("INSUFF")+1
|
|---|
| 32 | I DTCAN'<BDATE&(DTCAN'>EDATE),RQSTAT="X"!(RQSTAT="RX") S TOT("INCOMPLETE")=TOT("INCOMPLETE")+1
|
|---|
| 33 | K DTRPT Q
|
|---|
| 34 | ;
|
|---|
| 35 | GO S DVBABCNT=0
|
|---|
| 36 | S %DT="TS",X="NOW" D ^%DT S DVBCNOW=Y
|
|---|
| 37 | S PNAM="" F JJ=0:0 S PNAM=$O(^DVB(396.3,"B",PNAM)) Q:PNAM="" F REQDA=0:0 S REQDA=$O(^DVB(396.3,"B",PNAM,REQDA)) Q:REQDA="" D SET
|
|---|
| 38 | S TOT("AVGDAYS")=0 I TOT("COMPLETED")>0 S TOT("AVGDAYS")=TOT("DAYS")/TOT("COMPLETED"),TOT("AVGDAYS")=$J(TOT("AVGDAYS"),5,1)
|
|---|
| 39 | D BULLTXT^DVBCAMR1
|
|---|
| 40 | F JI=0:0 S JI=$O(^TMP($J,JI)) Q:JI="" S DVBABCNT=DVBABCNT+1,MSG(DVBABCNT)=^TMP($J,JI,0)
|
|---|
| 41 | S:'$D(XMY) SBULL="N" I SBULL="Y" D SEND
|
|---|
| 42 | ;
|
|---|
| 43 | EXIT K BDATE,%DT,DVBABCNT,C,DTCAN,DTREL,DTREQ,DTRQCMP,DTSCHEDC,DTTRANS,DVBCNOW,DVBCPCTM,EDATE,FA,FB,JI,JJ,L,PNAM,PRIO,REQDA,RONUM,RQSTAT,SBULL,TOT,X,X1,X2,XMDUZ,XMMG,Y,YY
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | BULL S XMDUZ=$P(^VA(200,DUZ,0),U),XMMG=$S($D(^VA(200,DUZ,0)):$P(^(0),U,1),1:""),XMY(DUZ)=""
|
|---|
| 47 | S XMSUB="RO AMIS 290 Report - " S Y=BDATE X ^DD("DD") S XMSUB=XMSUB_Y S Y=EDATE X ^DD("DD") S XMSUB=XMSUB_" to "_Y,XMTEXT="^TMP($J,"
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | SEND D ^XMD K XMY,XMTEXT,XMSUB
|
|---|
| 51 | S MSG(1)=">>> Mail message transmitted. <<<"
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
