28 lines
1.5 KiB
Mathematica
28 lines
1.5 KiB
Mathematica
QAOSPSM5 ;HISC/DAD-SUMMARY OF OCCURRENCE SCREENING - PENDING ;1/14/93 14:48
|
|
;;3.0;Occurrence Screen;;09/14/1993
|
|
K UNDL S $P(UNDL,"-",81)="",QAOSPAGE=1,%H=+$H D YX^%DTC S TODAY=Y
|
|
D HEAD S QAOSQUIT=0
|
|
I $O(^UTILITY($J,"QAOSPEND",0))'>0 W !!,"No pending occurrences found." G EXIT
|
|
F QAOSSCRN=0:0 S QAOSSCRN=$O(^UTILITY($J,"QAOSPEND",QAOSSCRN)) Q:QAOSSCRN'>0!QAOSQUIT D
|
|
. W !!,"SCREEN: ",QAOSSCRN," - ",$P($G(^QA(741.1,QAOSSCRN,0)),"^",2),!
|
|
. F QAOSDATE=0:0 S QAOSDATE=$O(^UTILITY($J,"QAOSPEND",QAOSSCRN,QAOSDATE)) Q:QAOSDATE'>0!QAOSQUIT S QAOSPAT="" F S QAOSPAT=$O(^UTILITY($J,"QAOSPEND",QAOSSCRN,QAOSDATE,QAOSPAT)) Q:QAOSPAT=""!QAOSQUIT D
|
|
.. F QAOSD0=0:0 S QAOSD0=$O(^UTILITY($J,"QAOSPEND",QAOSSCRN,QAOSDATE,QAOSPAT,QAOSD0)) Q:QAOSD0'>0!QAOSQUIT D
|
|
... S QA=^UTILITY($J,"QAOSPEND",QAOSSCRN,QAOSDATE,QAOSPAT,QAOSD0)
|
|
... S QAOSSN=$P(QA,"^"),QAOSKIND=$P(QA,"^",2)
|
|
... S Y=QAOSDATE X ^DD("DD") W !?3,QAOSPAT,?38,QAOSSN,?52,Y,?76,QAOSKIND
|
|
... I $Y>(IOSL-6),$Q(^UTILITY($J,"QAOSPEND",QAOSSCRN,QAOSDATE,QAOSPAT,QAOSD0))[($J_",""QAOSPEND"",") D PAUSE:$E(IOST)="C",HEAD:QAOSQUIT'>0
|
|
... Q
|
|
.. Q
|
|
. Q
|
|
EXIT D:($E(IOST)="C")&(QAOSQUIT'>0) PAUSE
|
|
Q
|
|
HEAD W @IOF,!!?31,"PENDING OCCURRENCES",?68,TODAY
|
|
W !?68,"PAGE: ",QAOSPAGE,!
|
|
W !,"Type 1 - Clinical action of 'Refer to Peer Review', but no Peer review was found"
|
|
W !,"Type 2 - Peer review(s) found for service(s), but none are marked as being final"
|
|
W !!?3,"PATIENT",?38,"SSN",?52,"DATE OF OCCURRENCE",?74,"TYPE",!,UNDL
|
|
S QAOSPAGE=QAOSPAGE+1
|
|
Q
|
|
PAUSE K DIR S DIR(0)="E" D ^DIR K DIR S QAOSQUIT=$S(Y'>0:1,1:0)
|
|
Q
|