| [613] | 1 | QAOSPTR0 ;HISC/DAD-REVIEW LEVEL TRACKING REPORT ;10/19/92 15:24
|
|---|
| 2 | ;;3.0;Occurrence Screen;;09/14/1993
|
|---|
| 3 | D ^QAQDATE G:QAQQUIT EXIT
|
|---|
| 4 | 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
|
|---|
| 5 | ENTSK ;
|
|---|
| 6 | 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")
|
|---|
| 7 | F QAOSD0=0:0 S QAOSD0=$O(^QA(741,"AD",0,QAOSD0)) Q:QAOSD0'>0 D:$D(^QA(741,QAOSD0,"REVR","B",QAOSCLIN)) LOOP1
|
|---|
| 8 | U IO D ^QAOSPTR1
|
|---|
| 9 | EXIT ;
|
|---|
| 10 | W ! D ^%ZISC
|
|---|
| 11 | 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")
|
|---|
| 12 | K %DT,D,DI,DIC,DQ,I,TYPE,Y,Z D K^QAQDATE S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 13 | Q
|
|---|
| 14 | LOOP1 ;
|
|---|
| 15 | 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)
|
|---|
| 16 | S SERV=$P(QAOSZERO,"^",6),SERV=$S(SERV="":"~UNKNOWN",$D(^DIC(49,SERV,0))#2:$P(^(0),"^"),1:"~UNKNOWN"),DATE=$P(QAOSZERO,"^",3)
|
|---|
| 17 | Q:(DATE<QAQNBEG)!(DATE>QAQNEND)
|
|---|
| 18 | S ^TMP($J,"QAOSPTR",SERV,SCRN,PAT,DATE)=SSN
|
|---|
| 19 | 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
|
|---|
| 20 | Q:QAOSQUIT S COUNT=1 F QAOSD1=0:0 S QAOSD1=$O(^QA(741,QAOSD0,"CMTE",QAOSD1)) Q:QAOSD1'>0 D CMTELOOP
|
|---|
| 21 | Q
|
|---|
| 22 | REVRLOOP ;
|
|---|
| 23 | 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:"")
|
|---|
| 24 | I FIND="",QAOSREVR=QAOSCLIN K ^TMP($J,"QAOSPTR",SERV,SCRN,PAT,DATE) S QAOSQUIT=1 Q
|
|---|
| 25 | 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:"")
|
|---|
| 26 | S X=$S(QAOSREVR=QAOSMGMT:ACTION,1:FIND) S:X]"" ^TMP($J,"QAOSPTR",SERV,SCRN,PAT,DATE,QAOSREVR,COUNT)=X,COUNT=COUNT+1
|
|---|
| 27 | Q
|
|---|
| 28 | CMTELOOP ;
|
|---|
| 29 | 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:"")
|
|---|
| 30 | S:FIND]"" ^TMP($J,"QAOSPTR",SERV,SCRN,PAT,DATE,QAOSCMTE,COUNT)=FIND,COUNT=COUNT+1
|
|---|
| 31 | Q
|
|---|
