source: FOIAVistA/trunk/r/OCCURRENCE_SCREEN-QAO/QAOSPCL0.m@ 757

QAOSPCL0 ;HISC/DAD-CLINICAL REVIEWER WORKSHEET (PART 1) ;2/12/93  15:16
 ;;3.0;Occurrence Screen;;09/14/1993
 I $D(^QA(740,1,"OS"))#2 Q:+$P(^("OS"),"^",3)=0
 Q:$D(^QA(741,QAOSD0,0))[0  Q:$D(^("SCRN"))[0
 S QAOSZERO=^QA(741,QAOSD0,0),(QAOSSCRN,SCRN)=+$G(^("SCRN")),QAOSQUIT=0,PAGE=1,HEADER=1,Y=DT X ^DD("DD") S TODAY=Y K UNDL S $P(UNDL,"=",80)="=" S SCRN=$G(^QA(741.1,SCRN,0)) Q:SCRN=""
 S QAOSCLIN=$O(^QA(741.2,"C",1,0)),QAOSD1=+$O(^QA(741,QAOSD0,"REVR","B",QAOSCLIN,0)),QAOSMULT=$S(QAOSD1'>0:"",$D(^QA(741,QAOSD0,"REVR",QAOSD1,0))#2:^(0),1:"")
 S:QAOSDATA=1 QAOSMULT="" S:(QAOSDATA=2)&('$D(^QA(741,QAOSD0,"REVR","B",QAOSCLIN))) QAOSMULT="" S QAOSPRIM=$P(QAOSMULT,"^",4)
 G:$O(^QA(741.4,"AC",QAOSSCRN,""))="" EXIT D HEAD
 F QAOSCODE=0:0 S QAOSCODE=$O(^QA(741.4,"AC",QAOSSCRN,QAOSCODE)) Q:QAOSCODE'>0!QAOSQUIT  F QAOSS0=0:0 S QAOSS0=$O(^QA(741.4,"AC",QAOSSCRN,QAOSCODE,QAOSS0)) Q:QAOSS0'>0!QAOSQUIT  D LOOP1
 G:QAOSQUIT DONE S QAOSHEAD="COMMENTS" W !!,QAOSHEAD S DIWL=4,DIWR=75,DIWF="" K ^UTILITY($J,"W")
 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
 F QA=0:0 S QA=$O(^UTILITY($J,"W",DIWL,QA)) Q:QA'>0!QAOSQUIT  W !?3,^UTILITY($J,"W",DIWL,QA,0) I $Y>(IOSL-6),$O(^UTILITY($J,"W",DIWL,QA)) D:$E(IOST)="C" PAUSE I 'QAOSQUIT S HEADER=0 D HEAD W !!,QAOSHEAD
DONE D:$E(IOST)="C" PAUSE:'QAOSQUIT W:$E(IOST)'="C" @IOF
EXIT ;
 K DIWF,DIWL,DIWR,FLAG,HEADER,LOC,NAME,PAGE,QA,QAOSCLIN,QAOSCODE,QAOSMULT,QAOSNUM,QAOSPRIM,QAOSS0,QAOSSCRN,QAOSWHEN,QAOSZERO,SCREEN,SCRN,SSN,TEXT,TODAY,UNDL,WARD,X,Y
 Q
LOOP1 ;
 S QAOSNUM=$P(^QA(741.4,QAOSS0,0),"^",1),X=$P($G(^(1)),"^",1),DIWF="",DIWL=15,DIWR=79
 K ^UTILITY($J,"W") D ^DIWP I $Y>(IOSL-6) D:$E(IOST)="C" PAUSE Q:QAOSQUIT  S HEADER=0 D HEAD
 W !!,$J(QAOSNUM,3),$S(QAOSS0=QAOSPRIM:"  (Y)/ N",1:"   Y / N")
 S FLAG=0 F QA=0:0 S QA=$O(^UTILITY($J,"W",DIWL,QA)) Q:QA'>0  W:FLAG ! W ?15,^UTILITY($J,"W",DIWL,QA,0) S FLAG=1
 Q
HEAD ;
 W:(PAGE>1)!($E(IOST)="C") @IOF
 W !!?23,"CLINICAL REVIEW WORKSHEET (PART 1)",?68,TODAY,!?68,"PAGE: ",PAGE S PAGE=PAGE+1 D EN6^QAQAUTL
 S LOC=$S($D(^DPT(+QAOSZERO,0))#2:^(0),1:+QAOSZERO),NAME=$P(LOC,"^"),SSN=$P(LOC,"^",9),Y=$P(QAOSZERO,"^",3)\1 X ^DD("DD") S QAOSWHEN=Y,SCREEN=+SCRN,TEXT=$P(SCRN,"^",2)
 S WARD=$S($D(^DPT(+QAOSZERO,.1))#2:$E(^(.1),1,22),1:"UNKNOWN"),WARD(0)=$P(QAOSZERO,"^",5),WARD(0)=$S(WARD(0)'>0:"______________________",$D(^SC(WARD(0),0))#2:$E($P(^(0),"^"),1,22),1:"______________________")
 W !,"PATIENT: ",NAME,?39,"SSN: ",SSN,?56,"OCCURRENCE: ",QAOSWHEN,!,"WARD/CLINIC- CURRENT: ",WARD,?46,"OCCURRENCE: ",WARD(0),!,SCREEN,?8,$E(TEXT,1,72) G:'HEADER INSTR
 S QA=$P(QAOSMULT,"^",2) W !!,"CLINICAL REVIEWER: ",$S(QA'>0:"________________________________",$D(^VA(200,QA,0))#2:$P(^(0),"^"),1:"________________________________"),?52,"REVIEW DATE: ______________"
 S LOC=^QA(741,QAOSD0,0),QA=$P(LOC,"^",10) W !!,"RESIDENT/PROVIDER: ",$S(QA'>0:"________________________",$D(^VA(200,QA,0))#2:$E($P(^(0),"^"),1,24),1:"________________________")
 S QA=$P(LOC,"^",9) W ?44,"ATTENDING: ",$S(QA'>0:"_________________________",$D(^VA(200,QA,0))#2:$E($P(^(0),"^"),1,25),1:"_________________________")
 S QA=$P(LOC,"^",7) W !!,"TREATING SPECIALTY: ",$S(QA'>0:"_______________________________",$D(^DIC(45.7,QA,0))#2:$P(^(0),"^"),1:"_______________________________")
INSTR W !!,"Instructions: Review the medical record and answer the following by circling",!,"the appropriate 'Y' or 'N'.  Record any comments at the end of the worksheet.",!,UNDL
 Q
PAUSE ;
 K DIR S DIR(0)="E" D ^DIR K DIR S QAOSQUIT=$S(Y'>0:1,1:0)
 Q