32 lines
2.3 KiB
Mathematica
32 lines
2.3 KiB
Mathematica
QAOSPTR0 ;HISC/DAD-REVIEW LEVEL TRACKING REPORT ;10/19/92 15:24
|
|
;;3.0;Occurrence Screen;;09/14/1993
|
|
D ^QAQDATE G:QAQQUIT EXIT
|
|
K %ZIS S %ZIS="QM" D ^%ZIS G:POP EXIT I $D(IO("Q")) S ZTDESC="Review level tracking report",ZTRTN="ENTSK^QAOSPTR0",ZTSAVE("QAQ*")="" D ^%ZTLOAD G EXIT
|
|
ENTSK ;
|
|
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)),QAOSCMTE=$O(^QA(741.2,"C",4,0)) K ^TMP($J,"QAOSPTR")
|
|
F QAOSD0=0:0 S QAOSD0=$O(^QA(741,"AD",0,QAOSD0)) Q:QAOSD0'>0 D:$D(^QA(741,QAOSD0,"REVR","B",QAOSCLIN)) LOOP1
|
|
U IO D ^QAOSPTR1
|
|
EXIT ;
|
|
W ! D ^%ZISC
|
|
K %ZIS,ACTION,COUNT,DATE,FIND,HEAD2,LEVEL,LOC,PAGE,PAT,POP,PT,QAOSCLIN,QAOSCMTE,QAOSD0,QAOSD1,QAOSD2,QAOSDT,QAOSMGMT,QAOSPEER,QAOSQUIT,QAOSREVR,QAOSRVW,QAOSZERO,REVR,SCRN,SERV,SRV,SSN,TODAY,UNDL,X,Y,ZTDESC,ZTRTN,^TMP($J,"QAOSPTR")
|
|
K %DT,D,DI,DIC,DQ,I,TYPE,Y,Z D K^QAQDATE S:$D(ZTQUEUED) ZTREQ="@"
|
|
Q
|
|
LOOP1 ;
|
|
S QAOSQUIT=0,QAOSZERO=^QA(741,QAOSD0,0),SCRN=+$G(^("SCRN")),PAT=$S($D(^DPT(+QAOSZERO,0))#2:^(0),1:+QAOSZERO),SSN=$P(PAT,"^",9),PAT=$P(PAT,"^"),SCRN=$S($D(^QA(741.1,SCRN,0))#2:+^(0),1:SCRN)
|
|
S SERV=$P(QAOSZERO,"^",6),SERV=$S(SERV="":"~UNKNOWN",$D(^DIC(49,SERV,0))#2:$P(^(0),"^"),1:"~UNKNOWN"),DATE=$P(QAOSZERO,"^",3)
|
|
Q:(DATE<QAQNBEG)!(DATE>QAQNEND)
|
|
S ^TMP($J,"QAOSPTR",SERV,SCRN,PAT,DATE)=SSN
|
|
F QAOSREVR=QAOSCLIN,QAOSPEER,QAOSMGMT Q:QAOSQUIT S COUNT=1 I $D(^QA(741,QAOSD0,"REVR","B",QAOSREVR)) F QAOSD1=0:0 S QAOSD1=$O(^QA(741,QAOSD0,"REVR","B",QAOSREVR,QAOSD1)) Q:QAOSD1'>0!QAOSQUIT D REVRLOOP
|
|
Q:QAOSQUIT S COUNT=1 F QAOSD1=0:0 S QAOSD1=$O(^QA(741,QAOSD0,"CMTE",QAOSD1)) Q:QAOSD1'>0 D CMTELOOP
|
|
Q
|
|
REVRLOOP ;
|
|
S QAOSRVW=$G(^QA(741,QAOSD0,"REVR",QAOSD1,0)),FIND=$P(QAOSRVW,"^",5),FIND=$S(FIND'>0:"",$D(^QA(741.6,FIND,0))#2:$P(^(0),"^",2),1:"")
|
|
I FIND="",QAOSREVR=QAOSCLIN K ^TMP($J,"QAOSPTR",SERV,SCRN,PAT,DATE) S QAOSQUIT=1 Q
|
|
S QAOSD2=$O(^QA(741,QAOSD0,"REVR",QAOSD1,2,0)),ACTION=$S(QAOSD2'>0:"",$D(^QA(741,QAOSD0,"REVR",QAOSD1,2,QAOSD2,0))#2:+^(0),1:""),ACTION=$S(ACTION'>0:"",$D(^QA(741.7,ACTION,0))#2:$P(^(0),"^",3),1:"")
|
|
S X=$S(QAOSREVR=QAOSMGMT:ACTION,1:FIND) S:X]"" ^TMP($J,"QAOSPTR",SERV,SCRN,PAT,DATE,QAOSREVR,COUNT)=X,COUNT=COUNT+1
|
|
Q
|
|
CMTELOOP ;
|
|
S QAOSRVW=$G(^QA(741,QAOSD0,"CMTE",QAOSD1,0)),FIND=$P(QAOSRVW,"^",2),FIND=$S(FIND'>0:"",$D(^QA(741.6,FIND,0))#2:$P(^(0),"^",2),1:"")
|
|
S:FIND]"" ^TMP($J,"QAOSPTR",SERV,SCRN,PAT,DATE,QAOSCMTE,COUNT)=FIND,COUNT=COUNT+1
|
|
Q
|