| 1 | QAOSPCL1 ;HISC/DAD-CLINICAL REVIEWER WORKSHEET (PART 2) ;5/7/93 20:27
|
|---|
| 2 | ;;3.0;Occurrence Screen;;09/14/1993
|
|---|
| 3 | S QAOSPAGE=1,QAOSQUIT=0,QAOSCLIN=$O(^QA(741.2,"C",1,0)),QAOSREVR=1,QAOSD1=$O(^QA(741,QAOSD0,"REVR","B",QAOSCLIN,0))
|
|---|
| 4 | S:QAOSDATA=1 QAOSD1="" S:(QAOSDATA=2)&('$D(^QA(741,QAOSD0,"REVR","B",QAOSCLIN))) QAOSD1=""
|
|---|
| 5 | S QAOSMULT=$S(QAOSD1'>0:"",$D(^QA(741,QAOSD0,"REVR",QAOSD1,0))#2:^(0),1:"")
|
|---|
| 6 | S QA=$P(QAOSMULT,"^",2) S $P(QAOSREVR,"^",2)=$S(QA'>0:"",$D(^VA(200,QA,0))#2:$P(^(0),"^"),1:"")
|
|---|
| 7 | S QAOSPAGE=1 D ^QAOSPHDR S QAOSSCRN=+$G(^QA(741,QAOSD0,"SCRN"))
|
|---|
| 8 | K ARRAY F D0=0:0 S D0=$O(^QA(741.5,"C",QAOSSCRN,D0)) Q:D0'>0 S LOC=^QA(741.5,D0,0),X=$D(^QA(741,QAOSD0,"REVR",+QAOSD1,1,"B",D0)) I $P(LOC,"^",4)'>0!X S ARRAY($P(LOC,"^",3)_"^"_$P(LOC,"^"))=$S(X:"_X_",1:"___")
|
|---|
| 9 | G:'$D(ARRAY) SKIP1 S QAOSHEAD="REASON(S) FOR EXCEPTION" W !!,QAOSHEAD S DIWL=10,DIWR=75,DIWF="",Y=""
|
|---|
| 10 | F QA=0:0 S Y=$O(ARRAY(Y)) Q:Y=""!QAOSQUIT K ^UTILITY($J,"W") S X=$P(Y,"^",2) D ^DIWP W !?3,ARRAY(Y),?8,$J($P(Y,"^"),3) F QA(0)=1:1:^UTILITY($J,"W",DIWL) Q:QAOSQUIT W:QA(0)>1 ! W ?15,^UTILITY($J,"W",DIWL,QA(0),0) D CHK
|
|---|
| 11 | G:QAOSQUIT EXIT
|
|---|
| 12 | SKIP1 ;
|
|---|
| 13 | S QAOSHEAD="FINDINGS" W !!,QAOSHEAD
|
|---|
| 14 | F QA=0:0 S QA=$O(^QA(741.6,"B",QA)) Q:QA'>0!QAOSQUIT F D0=0:0 S D0=$O(^QA(741.6,"B",QA,D0)) Q:D0'>0!QAOSQUIT S LOC=^QA(741.6,D0,0) I $P(LOC,"^",3)["1" W !?3,$S($P(QAOSMULT,"^",5)=D0:"_X_",1:"___"),?8,$J(QA,3,0),?15,$P(LOC,"^",2) D CHK
|
|---|
| 15 | G:QAOSQUIT EXIT
|
|---|
| 16 | S QAOSHEAD="PRIMARY REASON CLIN REFERRAL" W !!,QAOSHEAD S QA=$P(QAOSMULT,"^",4) I QA'>0 W ": __________________________________________________" G SKIP2
|
|---|
| 17 | S QA(0)=$P(^QA(741.4,QA,0),"^"),X=$P($G(^(1)),"^"),DIWL=10,DIWR=75,DIWF="" K ^UTILITY($J,"W") D ^DIWP W !?3,"_X_",?8,$J(QA(0),3) F QA=1:1:^UTILITY($J,"W",DIWL) Q:QAOSQUIT W:QA>1 ! W ?15,^UTILITY($J,"W",DIWL,QA,0) D CHK
|
|---|
| 18 | G:QAOSQUIT EXIT
|
|---|
| 19 | SKIP2 ;
|
|---|
| 20 | K ARRAY
|
|---|
| 21 | 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)["1" S ARRAY(+LOC)=$S(QAOSD1'>0:"___",$D(^QA(741,QAOSD0,"REVR",QAOSD1,2,"B",D0)):"_X_",1:"___")_"^"_$P(LOC,"^",3)
|
|---|
| 22 | 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),?15,$P(ARRAY(QA),"^",2) D CHK
|
|---|
| 23 | G:QAOSQUIT EXIT
|
|---|
| 24 | W !!,"DATE REVIEW COMPLETED: " S Y=$P(QAOSMULT,"^",3) X ^DD("DD") W $S(Y]"":Y,1:"____________________") D CHK G:QAOSQUIT EXIT
|
|---|
| 25 | S QAOSHEAD="" W !!,"Should the care in this case be considered for educational presentations" D CHK Q:QAOSQUIT
|
|---|
| 26 | W !,"because it was exemplary? ___ YES, ___ NO. If YES, describe." D CHK Q:QAOSQUIT
|
|---|
| 27 | S QAOSHEAD="COMMENTS" W !!,QAOSHEAD S DIWL=4,DIWR=75,DIWF="" K ^UTILITY($J,"W")
|
|---|
| 28 | 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
|
|---|
| 29 | 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
|
|---|
| 30 | G:QAOSQUIT EXIT
|
|---|
| 31 | BLANK I $Y<(IOSL-6) W ! G BLANK
|
|---|
| 32 | W !,"SIGNATURE"
|
|---|
| 33 | EXIT ;
|
|---|
| 34 | I ('QAOSQUIT)&($E(IOST)="C") K DIR S DIR(0)="E" D ^DIR K DIR S QAOSQUIT=$S(Y'>0:1,1:0)
|
|---|
| 35 | W:$E(IOST)'="C" @IOF
|
|---|
| 36 | EXIT0 K ARRAY,D0,DIWF,DIWL,DIWR,LOC,QA,QAOSCLIN,QAOSD1,QAOSHEAD,QAOSMULT,QAOSPAGE,QAOSREVR,QAOSSCRN,X,XX,Y
|
|---|
| 37 | Q
|
|---|
| 38 | CHK ;
|
|---|
| 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
|
|---|
