46 lines
3.0 KiB
Mathematica
46 lines
3.0 KiB
Mathematica
|
QAOSPDQ0 ;HISC/DAD-DELINQUENT REVIEWS REPORT ;10/19/92 15:03
|
||
|
|
;;3.0;Occurrence Screen;;09/14/1993
|
||
|
|
D ^QAQDATE G:QAQQUIT EXIT
|
||
|
|
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
|
||
|
|
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
|
||
|
|
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
|
||
|
|
ENTSK ;
|
||
|
|
K ^TMP($J,"QAOSPDQ")
|
||
|
|
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))_"^"
|
||
|
|
F QAOSD0=0:0 S QAOSD0=$O(^QA(741,"AD",0,QAOSD0)) Q:QAOSD0'>0 D LOOP1
|
||
|
|
U IO D ^QAOSPDQ1
|
||
|
|
EXIT ;
|
||
|
|
W ! D ^%ZISC
|
||
|
|
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
|
||
|
|
K QAOSZERO,TODAY,UNDL,X,Y,ZTDESC,ZTRTN,ZTSAVE,^TMP($J,"QAOSPDQ")
|
||
|
|
D K^QAQDATE S:$D(ZTQUEUED) ZTREQ="@"
|
||
|
|
Q
|
||
|
|
LOOP1 ;
|
||
|
|
S QAOSZERO=$G(^QA(741,QAOSD0,0)) Q:QAOSZERO="" S QAOSSCRN=+$G(^("SCRN")) Q:QAOSSCRN'>0
|
||
|
|
S Y=$P(QAOSZERO,"^",3) Q:(Y<QAQNBEG)!(Y>QAQNEND)
|
||
|
|
S QAOSPDUE=$P(QAOSZERO,"^",12),QAOSMDUE=$P(QAOSZERO,"^",13) Q:(QAOSPDUE="")!(QAOSMDUE="")
|
||
|
|
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)
|
||
|
|
S QAOSDATE=+$P(QAOSZERO,"^",3),QAOSSERV=+$P(QAOSZERO,"^",6),QAOSSERV=$S($D(^DIC(49,QAOSSERV,0))#2:$P(^(0),"^"),1:"~UNKNOWN")
|
||
|
|
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
|
||
|
|
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
|
||
|
|
Q
|
||
|
|
CHKPEER ;
|
||
|
|
S QAOSSUB="P",QAOSS1=$O(^QA(741,QAOSD0,"REVR","B",QAOSPEER,0)) I QAOSS1'>0 D CHKP Q
|
||
|
|
F QAOSS1=0:0 S QAOSS1=$O(^QA(741,QAOSD0,"REVR","B",QAOSPEER,QAOSS1)) Q:QAOSS1'>0 D CHKP
|
||
|
|
Q
|
||
|
|
CHKP S QAOSDONE=$P($G(^QA(741,QAOSD0,"REVR",+QAOSS1,0)),"^",3)
|
||
|
|
I DT>QAOSPDUE,QAOSDONE'>0 D SET
|
||
|
|
I QAOSLATE,QAOSDONE>QAOSPDUE D SET
|
||
|
|
Q
|
||
|
|
CHKMGMT ;
|
||
|
|
S QAOSSUB="M",QAOSS1=$O(^QA(741,QAOSD0,"REVR","B",QAOSMGMT,0)) I QAOSS1'>0 D CHKM Q
|
||
|
|
F QAOSS1=0:0 S QAOSS1=$O(^QA(741,QAOSD0,"REVR","B",QAOSMGMT,QAOSS1)) Q:QAOSS1'>0 D CHKM
|
||
|
|
Q
|
||
|
|
CHKM S QAOSDONE=$P($G(^QA(741,QAOSD0,"REVR",+QAOSS1,0)),"^",3)
|
||
|
|
I DT>QAOSMDUE,QAOSDONE'>0 D SET
|
||
|
|
I QAOSLATE,QAOSDONE>QAOSMDUE D SET
|
||
|
|
Q
|
||
|
|
SET ;
|
||
|
|
S ^TMP($J,"QAOSPDQ",QAOSSERV,QAOSNAME,QAOSDATE)=QAOSSCRN_"^"_QAOSSN_"^"_QAOSPDUE_"^"_QAOSMDUE,^(QAOSDATE,QAOSSUB,$S(QAOSS1:QAOSS1,1:1))=QAOSDONE
|
||
|
|
Q
|