QAOEDT0M ;HISC/DAD-MANAGEMENT REVIEW LEVEL EDIT ;2/3/93 15:58
;;3.0;Occurrence Screen;;09/14/1993
REVLEV S QAOSQUIT=0,QAOSREVR(0)=+^QA(741,QAOSD0,"REVR",QAOSD1,0)
K DR S DIE="^QA(741,"_QAOSD0_",""REVR"",",DR=".01"
S (D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1 D ^DIE G:('$D(DA))!($D(Y)) EXIT
S QAOSREVR(1)=+^QA(741,QAOSD0,"REVR",QAOSD1,0)
I QAOSREVR(0)'=QAOSREVR(1) D RESET^QAOEDT0 G REVLEV
K DR S DIE="^QA(741,"_QAOSD0_",""REVR"",",DR=".02T;.03"
S (D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1 D ^DIE G:$D(Y) EXIT
ACTION ;
S:$D(^QA(741,QAOSD0,"REVR",QAOSD1,2,0))[0 ^(0)="^741.15PA^^"
K DR S DIE="^QA(741,"_QAOSD0_",""REVR"","
S DR="5"_$S(QAOSQUIT:"//^S X=1",1:""),(D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1
D ^DIE G:$D(Y) EXIT
D CHKACT^QAOEDT0
K DR S DIE="^QA(741,"_QAOSD0_",""REVR"",",DR="10;1"
S (D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1 D ^DIE G:$D(Y) EXIT
EXIT ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOEDT0M 862 printed Nov 22, 2024@17:31:06 Page 2
QAOEDT0M ;HISC/DAD-MANAGEMENT REVIEW LEVEL EDIT ;2/3/93 15:58
+1 ;;3.0;Occurrence Screen;;09/14/1993
REVLEV SET QAOSQUIT=0
SET QAOSREVR(0)=+^QA(741,QAOSD0,"REVR",QAOSD1,0)
+1 KILL DR
SET DIE="^QA(741,"_QAOSD0_",""REVR"","
SET DR=".01"
+2 SET (D0,DA(1))=QAOSD0
SET (D1,DA)=QAOSD1
DO ^DIE
if ('$DATA(DA))!($DATA(Y))
GOTO EXIT
+3 SET QAOSREVR(1)=+^QA(741,QAOSD0,"REVR",QAOSD1,0)
+4 IF QAOSREVR(0)'=QAOSREVR(1)
DO RESET^QAOEDT0
GOTO REVLEV
+5 KILL DR
SET DIE="^QA(741,"_QAOSD0_",""REVR"","
SET DR=".02T;.03"
+6 SET (D0,DA(1))=QAOSD0
SET (D1,DA)=QAOSD1
DO ^DIE
if $DATA(Y)
GOTO EXIT
ACTION ;
+1 if $DATA(^QA(741,QAOSD0,"REVR",QAOSD1,2,0))[0
SET ^(0)="^741.15PA^^"
+2 KILL DR
SET DIE="^QA(741,"_QAOSD0_",""REVR"","
+3 SET DR="5"_$SELECT(QAOSQUIT:"//^S X=1",1:"")
SET (D0,DA(1))=QAOSD0
SET (D1,DA)=QAOSD1
+4 DO ^DIE
if $DATA(Y)
GOTO EXIT
+5 DO CHKACT^QAOEDT0
+6 KILL DR
SET DIE="^QA(741,"_QAOSD0_",""REVR"","
SET DR="10;1"
+7 SET (D0,DA(1))=QAOSD0
SET (D1,DA)=QAOSD1
DO ^DIE
if $DATA(Y)
GOTO EXIT
EXIT ;
+1 QUIT
