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

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1QAOSPMG0 ;HISC/DAD-MANAGEMENT REVIEWER WORKSHEET ;2/16/93 09:26
2 ;;3.0;Occurrence Screen;;09/14/1993
3 S QAOSSCRN=+$G(^QA(741,QAOSD0,"SCRN")),QAOSMGMT=$O(^QA(741.2,"C",3,0)),QAOSREVR=3,QAOSQUIT=0
4 I QAOSDATA=1 S QAOSD1="" D LOOP1 W:$E(IOST)'="C" @IOF D G EXIT
5 . Q:$E(IOST)'="C" Q:QAOSQUIT
6 . K DIR S DIR(0)="E" D ^DIR K DIR
7 . S QAOSQUIT=$S(Y'>0:1,1:0)
8 . Q
9 I QAOSDATA=2,'$D(^QA(741,QAOSD0,"REVR","B",QAOSMGMT)) S QAOSD1="" D LOOP1 W:$E(IOST)'="C" @IOF D G EXIT
10 . Q:$E(IOST)'="C" Q:QAOSQUIT
11 . K DIR S DIR(0)="E" D ^DIR K DIR
12 . S QAOSQUIT=$S(Y'>0:1,1:0)
13 . Q
14 F QAOSD1=0:0 S QAOSD1=$O(^QA(741,QAOSD0,"REVR","B",QAOSMGMT,QAOSD1)) Q:QAOSD1'>0!QAOSQUIT D LOOP1 W:$E(IOST)'="C" @IOF I ('QAOSQUIT),$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S QAOSQUIT=$S(Y'>0:1,1:0) Q:QAOSQUIT
15EXIT ;
16 K ARRAY,D0,DIWF,DIWL,DIWR,LOC,QA,QAOSD1,QAOSHEAD,QAOSMULT,QAOSPAGE,QAOSREVR,QAOSSCRN,QAOSMGMT,X,XX,Y
17 Q
18LOOP1 ;
19 S QAOSMULT=$S(QAOSD1'>0:"",$D(^QA(741,QAOSD0,"REVR",QAOSD1,0))#2:^(0),1:"")
20 S QA=$P(QAOSMULT,"^",2) S $P(QAOSREVR,"^",2)=$S(QA'>0:"",$D(^VA(200,QA,0))#2:$P(^(0),"^"),1:"")
21 S QAOSPAGE=1 D ^QAOSPHDR K ARRAY
22 F QA=0:0 S QA=$O(^QA(741.7,"B",QA)) Q:QA'>0 F D0=0:0 S D0=$O(^QA(741.7,"B",QA,D0)) Q:D0'>0 S LOC=^QA(741.7,D0,0) I $P(LOC,"^",2)["3" S ARRAY(+LOC)=$S(QAOSD1'>0:"___",$D(^QA(741,QAOSD0,"REVR",QAOSD1,2,"B",D0)):"_X_",1:"___")_"^"_$P(LOC,"^",3)
23 S QAOSHEAD="ACTION(S)" W !!,QAOSHEAD F QA=0:0 S QA=$O(ARRAY(QA)) Q:QA'>0!QAOSQUIT W !?3,$P(ARRAY(QA),"^"),?8,$J(QA,3,0),?15,$P(ARRAY(QA),"^",2) D CHK
24 Q:QAOSQUIT
25 W !!,"DATE REVIEW COMPLETED: " S Y=$P(QAOSMULT,"^",3) X ^DD("DD") W $S(Y]"":Y,1:"____________________")
26 S QAOSMDUE=$P($G(^QA(741,QAOSD0,0)),"^",13),QAOSMDAY=$P($G(^QA(740,1,"OS")),"^",2) I QAOSMDUE!QAOSMDAY D
27 . S Y=QAOSMDUE X ^DD("DD") W ?47,"DUE DATE: "
28 . W $S((QAOSHOW=3)!(QAOSDATA=1)!(Y=""):"____________________",1:Y)
29 . Q
30 D CHK Q:QAOSQUIT
31 S QAOSHEAD="COMMENTS" W !!,QAOSHEAD S DIWL=4,DIWR=75,DIWF="" K ^UTILITY($J,"W")
32 I QAOSHOW'=3,QAOSDATA=2 F QAOSS0=0:0 S QAOSS0=$O(^QA(741,QAOSD0,"REVR",+QAOSD1,3,QAOSS0)) Q:QAOSS0'>0 S X=^QA(741,QAOSD0,"REVR",QAOSD1,3,QAOSS0,0) D ^DIWP
33 F QA=0:0 S QA=$O(^UTILITY($J,"W",DIWL,QA)) Q:QA'>0!QAOSQUIT W !?3,^UTILITY($J,"W",DIWL,QA,0) D CHK
34 Q:QAOSQUIT
35BLANK I $Y<(IOSL-6) W ! G BLANK
36 W !,"SIGNATURE"
37 Q
38CHK ;
39 Q:$Y'>(IOSL-6) N D0,QA,Y I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S QAOSQUIT=$S(Y'>0:1,1:0) Q:QAOSQUIT
40 D ^QAOSPHDR W !!,QAOSHEAD
41 Q
Note: See TracBrowser for help on using the repository browser.