source: FOIAVistA/trunk/r/OCCURRENCE_SCREEN-QAO/QAOSPDQ0.m@ 1397

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