| [613] | 1 | QAOSPDQ0 ;HISC/DAD-DELINQUENT REVIEWS REPORT ;10/19/92 15:03
|
|---|
| 2 | ;;3.0;Occurrence Screen;;09/14/1993
|
|---|
| 3 | D ^QAQDATE G:QAQQUIT EXIT
|
|---|
| 4 | ASK W !,"Include reviews that were completed after the due date" S %=2 D YN^DICN S QAOSLATE=$S(%=1:1,1:0) G:%=-1 EXIT
|
|---|
| 5 | I '% W !!?5,"Enter Y(es) to include those peer and management reviews that",!?5,"were done, but were completed after the due dates.",!?5,"Enter N(o) to include only those reviews requested, but not",!?5,"yet completed.",! G ASK
|
|---|
| 6 | K %ZIS S %ZIS="QM" W ! D ^%ZIS G:POP EXIT I $D(IO("Q")) S ZTDESC="Delinquent reviews report",ZTRTN="ENTSK^QAOSPDQ0",ZTSAVE("QAOSLATE")="",ZTSAVE("QAQ*")="" D ^%ZTLOAD G EXIT
|
|---|
| 7 | ENTSK ;
|
|---|
| 8 | K ^TMP($J,"QAOSPDQ")
|
|---|
| 9 | S QAOSCLIN=$O(^QA(741.2,"C",1,0)),QAOSPEER=$O(^QA(741.2,"C",2,0)),QAOSMGMT=$O(^QA(741.2,"C",3,0)),QAOSREFP="^"_$O(^QA(741.7,"B",2,0))_"^",QAOSREFM="^" F QA=3,5,6,7 S QAOSREFM=QAOSREFM_$O(^QA(741.7,"B",QA,0))_"^"
|
|---|
| 10 | F QAOSD0=0:0 S QAOSD0=$O(^QA(741,"AD",0,QAOSD0)) Q:QAOSD0'>0 D LOOP1
|
|---|
| 11 | U IO D ^QAOSPDQ1
|
|---|
| 12 | EXIT ;
|
|---|
| 13 | W ! D ^%ZISC
|
|---|
| 14 | K %,%DT,%ZIS,DIR,PAGE,POP,QA,QAOS,QAOSACTN,QAOSCLIN,QAOSD0,QAOSD1,QAOSDATE,QAOSDONE,QAOSDT,QAOSLATE,QAOSM,QAOSMDUE,QAOSMGMT,QAOSNAME,QAOSP,QAOSPDUE,QAOSPEER,QAOSQUIT,QAOSREFM,QAOSREFP,QAOSS1,QAOSSCRN,QAOSSERV,QAOSSN,QAOSSUB
|
|---|
| 15 | K QAOSZERO,TODAY,UNDL,X,Y,ZTDESC,ZTRTN,ZTSAVE,^TMP($J,"QAOSPDQ")
|
|---|
| 16 | D K^QAQDATE S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 17 | Q
|
|---|
| 18 | LOOP1 ;
|
|---|
| 19 | S QAOSZERO=$G(^QA(741,QAOSD0,0)) Q:QAOSZERO="" S QAOSSCRN=+$G(^("SCRN")) Q:QAOSSCRN'>0
|
|---|
| 20 | S Y=$P(QAOSZERO,"^",3) Q:(Y<QAQNBEG)!(Y>QAQNEND)
|
|---|
| 21 | S QAOSPDUE=$P(QAOSZERO,"^",12),QAOSMDUE=$P(QAOSZERO,"^",13) Q:(QAOSPDUE="")!(QAOSMDUE="")
|
|---|
| 22 | S QAOS=$S($D(^DPT(+QAOSZERO,0))#2:^(0),1:+QAOSZERO),QAOSNAME=$P(QAOS,"^"),QAOSSN=$P(QAOS,"^",9),QAOSSCRN=$S($D(^QA(741.1,QAOSSCRN,0))#2:$P(^(0),"^"),1:QAOSSCRN)
|
|---|
| 23 | S QAOSDATE=+$P(QAOSZERO,"^",3),QAOSSERV=+$P(QAOSZERO,"^",6),QAOSSERV=$S($D(^DIC(49,QAOSSERV,0))#2:$P(^(0),"^"),1:"~UNKNOWN")
|
|---|
| 24 | F QAOSD1=0:0 S QAOSD1=$O(^QA(741,QAOSD0,"REVR","B",QAOSCLIN,QAOSD1)) Q:QAOSD1'>0 F QAOSACTN=2:1:$L(QAOSREFP,"^")-1 I $O(^QA(741,QAOSD0,"REVR",QAOSD1,2,"B",QAOSACTN,0)) D CHKPEER
|
|---|
| 25 | F QAOSD1=0:0 S QAOSD1=$O(^QA(741,QAOSD0,"REVR","B",QAOSPEER,QAOSD1)) Q:QAOSD1'>0 F QAOSACTN=2:1:$L(QAOSREFM,"^")-1 I $O(^QA(741,QAOSD0,"REVR",QAOSD1,2,"B",QAOSACTN,0)) D CHKMGMT
|
|---|
| 26 | Q
|
|---|
| 27 | CHKPEER ;
|
|---|
| 28 | S QAOSSUB="P",QAOSS1=$O(^QA(741,QAOSD0,"REVR","B",QAOSPEER,0)) I QAOSS1'>0 D CHKP Q
|
|---|
| 29 | F QAOSS1=0:0 S QAOSS1=$O(^QA(741,QAOSD0,"REVR","B",QAOSPEER,QAOSS1)) Q:QAOSS1'>0 D CHKP
|
|---|
| 30 | Q
|
|---|
| 31 | CHKP S QAOSDONE=$P($G(^QA(741,QAOSD0,"REVR",+QAOSS1,0)),"^",3)
|
|---|
| 32 | I DT>QAOSPDUE,QAOSDONE'>0 D SET
|
|---|
| 33 | I QAOSLATE,QAOSDONE>QAOSPDUE D SET
|
|---|
| 34 | Q
|
|---|
| 35 | CHKMGMT ;
|
|---|
| 36 | S QAOSSUB="M",QAOSS1=$O(^QA(741,QAOSD0,"REVR","B",QAOSMGMT,0)) I QAOSS1'>0 D CHKM Q
|
|---|
| 37 | F QAOSS1=0:0 S QAOSS1=$O(^QA(741,QAOSD0,"REVR","B",QAOSMGMT,QAOSS1)) Q:QAOSS1'>0 D CHKM
|
|---|
| 38 | Q
|
|---|
| 39 | CHKM S QAOSDONE=$P($G(^QA(741,QAOSD0,"REVR",+QAOSS1,0)),"^",3)
|
|---|
| 40 | I DT>QAOSMDUE,QAOSDONE'>0 D SET
|
|---|
| 41 | I QAOSLATE,QAOSDONE>QAOSMDUE D SET
|
|---|
| 42 | Q
|
|---|
| 43 | SET ;
|
|---|
| 44 | S ^TMP($J,"QAOSPDQ",QAOSSERV,QAOSNAME,QAOSDATE)=QAOSSCRN_"^"_QAOSSN_"^"_QAOSPDUE_"^"_QAOSMDUE,^(QAOSDATE,QAOSSUB,$S(QAOSS1:QAOSS1,1:1))=QAOSDONE
|
|---|
| 45 | Q
|
|---|
