| [613] | 1 | QAOSPSY0 ;HISC/DAD-SYSTEM / EQUIPMENT PROBLEMS ;6/11/93 15:59
|
|---|
| 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="System/equipment problems report",ZTRTN="ENTSK^QAOSPSY0",ZTSAVE("QAOS*")="",ZTSAVE("QAQ*")="" D ^%ZTLOAD G EXIT
|
|---|
| 5 | ENTSK ;
|
|---|
| 6 | K ^TMP($J,"QAOSPSY"),UNDL S $P(UNDL,"-",80)="-" S QAOSQUIT=0,PAGE=1,Y=DT X ^DD("DD") S TODAY=$P(Y,"@")
|
|---|
| 7 | F QAOSDT=QAQNBEG-.0000001:0 S QAOSDT=$O(^QA(741,"C",QAOSDT)) Q:(QAOSDT'>0)!(QAOSDT>QAQNEND) F QAOSD0=0:0 S QAOSD0=$O(^QA(741,"C",QAOSDT,QAOSD0)) Q:QAOSD0'>0 D LOOP1
|
|---|
| 8 | U IO D HEAD I '$D(^TMP($J,"QAOSPSY")) W !!,"NO DATA FOUND FOR THIS REPORT" G EXIT
|
|---|
| 9 | S SERV="" F SRV=0:0 S SERV=$O(^TMP($J,"QAOSPSY",SERV)) Q:SERV=""!QAOSQUIT D SUBHEAD S PAT="" F PT=0:0 S PAT=$O(^TMP($J,"QAOSPSY",SERV,PAT)) Q:PAT=""!QAOSQUIT F SCRN=0:0 S SCRN=$O(^TMP($J,"QAOSPSY",SERV,PAT,SCRN)) Q:SCRN'>0!QAOSQUIT D PRT1
|
|---|
| 10 | EXIT ;
|
|---|
| 11 | W ! D ^%ZISC
|
|---|
| 12 | K %ZIS,CONFIRM,LOC,PAGE,PAT,PATIENT,PT,POP,QAOSD0,QAOSDT,QAOSQUIT,QAOSZERO,SCREEN,SCRN,SERV,SERVICE,SRV,SSN,STATUS,TODAY,UNDL,X,Y,ZTDESC,ZTRTN,ZTSAVE,%DT,D,I,Y,Z,QA,QAOSD1,^TMP($J,"QAOSPSY")
|
|---|
| 13 | D K^QAQDATE S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 14 | Q
|
|---|
| 15 | LOOP1 ;
|
|---|
| 16 | S QAOSZERO=^QA(741,QAOSD0,0),SCRN=+$G(^("SCRN")),STATUS=$P(QAOSZERO,"^",11) Q:STATUS=2 S STATUS=$S(+STATUS=0:" OPEN",1:"CLOSED")
|
|---|
| 17 | K CONFIRM F QA=1:1:4 S CONFIRM(QA)=0
|
|---|
| 18 | F QAOSD1=0:0 S QAOSD1=$O(^QA(741,QAOSD0,"CMTE",QAOSD1)) Q:QAOSD1'>0 D
|
|---|
| 19 | . S CONFIRM=+$P($G(^QA(741,QAOSD0,"CMTE",QAOSD1,0)),"^",5)
|
|---|
| 20 | . Q:CONFIRM=4 S CONFIRM(CONFIRM)=1
|
|---|
| 21 | . Q
|
|---|
| 22 | S CONFIRM=$S(CONFIRM(3)!(CONFIRM(1)&CONFIRM(2)):"SYSTEM & EQUIP",CONFIRM(1):"EQUIPMENT",CONFIRM(2):"SYSTEM",1:"") Q:CONFIRM=""
|
|---|
| 23 | S LOC=$G(^QA(741.1,SCRN,0)),SCREEN=$P(LOC,"^",2),SCRN=$S(LOC]"":+LOC,1:SCRN)
|
|---|
| 24 | S SERVICE=$P(QAOSZERO,"^",6),SERVICE=$S(SERVICE'>0:"~UNKNOWN",$D(^DIC(49,SERVICE,0))#2:$P(^(0),"^"),1:"~UNKNOWN")
|
|---|
| 25 | S LOC=$G(^DPT(+QAOSZERO,0)),PATIENT=$S(LOC]"":$P(LOC,"^"),1:+QAOSZERO),SSN=$P(LOC,"^",9)
|
|---|
| 26 | S ^TMP($J,"QAOSPSY",SERVICE,PATIENT,SCRN,QAOSDT)=SSN_"^"_STATUS_"^"_CONFIRM_"^"_SCREEN
|
|---|
| 27 | Q
|
|---|
| 28 | PRT1 ;
|
|---|
| 29 | F QAOSDT=0:0 S QAOSDT=$O(^TMP($J,"QAOSPSY",SERV,PAT,SCRN,QAOSDT)) Q:QAOSDT'>0!QAOSQUIT D PRT2
|
|---|
| 30 | Q
|
|---|
| 31 | PRT2 ;
|
|---|
| 32 | S LOC=^TMP($J,"QAOSPSY",SERV,PAT,SCRN,QAOSDT),SSN=+LOC,STATUS=$P(LOC,"^",2),CONFIRM=$P(LOC,"^",3),SCREEN=$P(LOC,"^",4),Y=QAOSDT\1 X ^DD("DD")
|
|---|
| 33 | W !!,PAT,?32,SSN,?43,Y,?56,STATUS,?64,CONFIRM,!?1,SCRN,?8,$E(SCREEN,1,72)
|
|---|
| 34 | I $Y>(IOSL-6) D:$E(IOST)="C" PAUSE Q:QAOSQUIT D HEAD,SUBHEAD:($O(^TMP($J,"QAOSPSY",SERV,PAT))]"")!($O(^TMP($J,"QAOSPSY",SERV,PAT,SCRN))]"")!($O(^TMP($J,"QAOSPSY",SERV,PAT,SCRN,QAOSDT))]"")
|
|---|
| 35 | Q
|
|---|
| 36 | HEAD ;
|
|---|
| 37 | W:(PAGE>1)!($E(IOST)="C") @IOF
|
|---|
| 38 | W !!?26,"SYSTEM / EQUIPMENT PROBLEMS",?68,TODAY,!?QAQTART,QAQ2HED,?68,"PAGE: ",PAGE S PAGE=PAGE+1 D EN6^QAQAUTL
|
|---|
| 39 | W !,"PATIENT / SCREEN",?32,"SSN",?43,"DATE",?56,"STATUS",?64,"CONFIRMED ISSUE",!,UNDL
|
|---|
| 40 | Q
|
|---|
| 41 | SUBHEAD ;
|
|---|
| 42 | W !!?3,"SERVICE: ",$S(SERV["~":$P(SERV,"~",2),1:SERV)
|
|---|
| 43 | Q
|
|---|
| 44 | PAUSE ;
|
|---|
| 45 | K DIR S DIR(0)="E" D ^DIR K DIR S QAOSQUIT=$S(Y'>0:1,1:0)
|
|---|
| 46 | Q
|
|---|
