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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSPSM5 1595 printed Nov 22, 2024@17:31:58 Page 2
QAOSPSM5 ;HISC/DAD-SUMMARY OF OCCURRENCE SCREENING - PENDING ;1/14/93 14:48
+1 ;;3.0;Occurrence Screen;;09/14/1993
+2 KILL UNDL
SET $PIECE(UNDL,"-",81)=""
SET QAOSPAGE=1
SET %H=+$HOROLOG
DO YX^%DTC
SET TODAY=Y
+3 DO HEAD
SET QAOSQUIT=0
+4 IF $ORDER(^UTILITY($JOB,"QAOSPEND",0))'>0
WRITE !!,"No pending occurrences found."
GOTO EXIT
+5 FOR QAOSSCRN=0:0
SET QAOSSCRN=$ORDER(^UTILITY($JOB,"QAOSPEND",QAOSSCRN))
if QAOSSCRN'>0!QAOSQUIT
QUIT
Begin DoDot:1
+6 WRITE !!,"SCREEN: ",QAOSSCRN," - ",$PIECE($GET(^QA(741.1,QAOSSCRN,0)),"^",2),!
+7 FOR QAOSDATE=0:0
SET QAOSDATE=$ORDER(^UTILITY($JOB,"QAOSPEND",QAOSSCRN,QAOSDATE))
if QAOSDATE'>0!QAOSQUIT
QUIT
SET QAOSPAT=""
FOR
SET QAOSPAT=$ORDER(^UTILITY($JOB,"QAOSPEND",QAOSSCRN,QAOSDATE,QAOSPAT))
if QAOSPAT=""!QAOSQUIT
QUIT
Begin DoDot:2
+8 FOR QAOSD0=0:0
SET QAOSD0=$ORDER(^UTILITY($JOB,"QAOSPEND",QAOSSCRN,QAOSDATE,QAOSPAT,QAOSD0))
if QAOSD0'>0!QAOSQUIT
QUIT
Begin DoDot:3
+9 SET QA=^UTILITY($JOB,"QAOSPEND",QAOSSCRN,QAOSDATE,QAOSPAT,QAOSD0)
+10 SET QAOSSN=$PIECE(QA,"^")
SET QAOSKIND=$PIECE(QA,"^",2)
+11 SET Y=QAOSDATE
XECUTE ^DD("DD")
WRITE !?3,QAOSPAT,?38,QAOSSN,?52,Y,?76,QAOSKIND
+12 IF $Y>(IOSL-6)
IF $QUERY(^UTILITY($JOB,"QAOSPEND",QAOSSCRN,QAOSDATE,QAOSPAT,QAOSD0))[($JOB_",""QAOSPEND"",")
if $EXTRACT(IOST)="C"
DO PAUSE
if QAOSQUIT'>0
DO HEAD
+13 QUIT
End DoDot:3
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
EXIT if ($EXTRACT(IOST)="C")&(QAOSQUIT'>0)
DO PAUSE
+1 QUIT
HEAD WRITE @IOF,!!?31,"PENDING OCCURRENCES",?68,TODAY
+1 WRITE !?68,"PAGE: ",QAOSPAGE,!
+2 WRITE !,"Type 1 - Clinical action of 'Refer to Peer Review', but no Peer review was found"
+3 WRITE !,"Type 2 - Peer review(s) found for service(s), but none are marked as being final"
+4 WRITE !!?3,"PATIENT",?38,"SSN",?52,"DATE OF OCCURRENCE",?74,"TYPE",!,UNDL
+5 SET QAOSPAGE=QAOSPAGE+1
+6 QUIT
PAUSE KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET QAOSQUIT=$SELECT(Y'>0:1,1:0)
+1 QUIT
