source: WorldVistAEHR/trunk/r/OCCURRENCE_SCREEN-QAO/QAOSPDQ0.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1QAOSPDQ0 ;HISC/DAD-DELINQUENT REVIEWS REPORT ;10/19/92 15:03
2 ;;3.0;Occurrence Screen;;09/14/1993
3 D ^QAQDATE G:QAQQUIT EXIT
4ASK 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
7ENTSK ;
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
12EXIT ;
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
18LOOP1 ;
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
27CHKPEER ;
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
31CHKP 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
35CHKMGMT ;
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
39CHKM 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
43SET ;
44 S ^TMP($J,"QAOSPDQ",QAOSSERV,QAOSNAME,QAOSDATE)=QAOSSCRN_"^"_QAOSSN_"^"_QAOSPDUE_"^"_QAOSMDUE,^(QAOSDATE,QAOSSUB,$S(QAOSS1:QAOSS1,1:1))=QAOSDONE
45 Q
Note: See TracBrowser for help on using the repository browser.