GMRCTIU1 ;SLC/JER - More CT/TIU interface modules ;7/9/2003 [7/9/03 1:51pm]
;;3.0;CONSULT/REQUEST TRACKING;**1,4,21,17,34,46**;DEC 27, 1997;Build 23
;
;This routine invokes IA #2693
ROLLBACK(DA,TIUDA) ; Roll-back a CT record when result is deleted or
;reassigned
;Disassociate Note logic
;The action removes the association of a TIU note with a consult.
;The new CPRS status will change to "ACTIVE", unless one of the
;remaining notes has a completed status.
;This action should send an alert to the service notification users.
N DIE,DR,GMRCSTS,GMRCA,GMRCO,GMRCOM,GMRCORNP,GMRCDFN,GMRCNODE,GMRCLIST,GMRCD0,GMRCD1,GMRCSF,GMRCADUZ,MSGTOSRV,GMRCATX,GMRCORTX,GMRCSTAR,GMRCERR,ACTDA,ACTREC,GMRCLSCH,GMRCLER,GMRCRBDA,GMRCTDA,GMRCRSLT
S GMRCNODE=$G(^GMR(123,+DA,0))
; If current result has never been posted, no need to roll back
; Patch GMRC*1*21
I '+$O(^GMR(123,+DA,50,"B",+TIUDA_";TIU(8925,",0)) Q
I ($P(GMRCNODE,U,20)=TIUDA) S DIE="^GMR(123,",DR="16///@" D ^DIE
S GMRCD0=DA,GMRCD1=0 F S GMRCD1=$O(^GMR(123,GMRCD0,50,GMRCD1)) Q:'GMRCD1 D
.N DA,DIK
.Q:'(TIUDA=+$G(^GMR(123,GMRCD0,50,GMRCD1,0)))
.S DA(1)=GMRCD0,DA=GMRCD1
.S DIK="^GMR(123,"_DA(1)_",50,"
.D ^DIK
;
S GMRCA=12,GMRCO=DA
D GETLIST^GMRCTIUL(DA,2,1,.GMRCLIST)
S GMRCSTS=9
;Following if statement and DO block accomplish the following
;If there are no other associated TIU Docs then
;Set status to scheduled if it was last status before the TIU doc
;Set status to pending if it was the last status before the TIU doc
;Set status to active otherwise
I '$G(GMRCLIST(0)) S GMRCSTS=6 D
.S ACTDA=0,ACTREC=0,GMRCRBDA=0,GMRCLER=-1,GMRCLSCH=-1
.F S ACTDA=$O(^GMR(123,DA,40,ACTDA)) Q:-ACTDA=0 D
..S ACTREC=$G(^GMR(123,DA,40,ACTDA,0))
..I $P(ACTREC,U,2)=9,$P($P(ACTREC,U,9),";",1)=TIUDA S GMRCRBDA=ACTDA
..I $P(ACTREC,U,2)=8 S GMRCLSCH=ACTDA
..I $P(ACTREC,U,2)=11 S GMRCLER=ACTDA
.I GMRCLER'=-1,GMRCLER>GMRCLSCH S GMRCSTS=5
.I GMRCLSCH'=-1,GMRCLSCH>GMRCLER S GMRCSTS=8
E S GMRCD0="" F S GMRCD0=$O(^TMP("GMRC50",$J,GMRCD0)) Q:'$L(GMRCD0) D
.Q:(+GMRCD0=TIUDA)
.S GMRCD1=0 F S GMRCD1=$O(^TMP("GMRC50",$J,GMRCD0,GMRCD1)) Q:'GMRCD1 D
..S:($P($G(^TMP("GMRC50",$J,GMRCD0,GMRCD1)),U,6)="completed") GMRCSTS=2
Q:$G(NOSAVE)
;Make status completed if the Consult was Admin. Completed
S ACTDA=0,ACTREC=0
F S ACTDA=$O(^GMR(123,DA,40,ACTDA)) Q:-ACTDA=0 D
.S ACTREC=$G(^GMR(123,DA,40,ACTDA,0))
.I $P(ACTREC,U,2)=10,$P(ACTREC,U,9)="" S GMRCSTS=2
D STATUS^GMRCP
K ^TMP("GMRC50",$J),^TMP("GMRC50R",$J)
;
S GMRCOM=0,MSGTOSRV=0,GMRCRSLT=TIUDA_";TIU(8925," D AUDIT^GMRCP
;
;Build message information if status has changed or sig finding="Y"
S GMRCSF=$P(GMRCNODE,U,19)
I ($P(GMRCNODE,U,12)=$P($G(^GMR(123,GMRCO,0)),U,12)) D Q:GMRCATX=""
. S GMRCATX="" Q:GMRCSF'="Y"
. S GMRCATX="*Removed consult note for "
E S GMRCATX=$S((GMRCSF="Y"):"*",1:"")_"Reactivated consult, removed note for ",MSGTOSRV=1
S GMRCORNP=$P(GMRCNODE,U,14),GMRCDFN=$P(GMRCNODE,U,2)
S GMRCORTX=$$ORTX^GMRCAU(GMRCO)
S GMRCORTX=GMRCATX_GMRCORTX
S:((GMRCORNP)&(GMRCORNP'=DUZ)) GMRCADUZ(GMRCORNP)=""
S GMRCTDA=TIUDA
D EXTRACT^TIULQ(GMRCTDA,"GMRCSTAR",.GMRCERR,.05)
I '$G(GMRCERR) D
.I $G(GMRCSTAR(GMRCTDA,.05,"I"))'=5 D
..D MSG^GMRCP(GMRCDFN,GMRCORTX,+GMRCO,23,.GMRCADUZ,MSGTOSRV)
Q:($P(GMRCNODE,U,12)=$P($G(^GMR(123,+GMRCO,0)),U,12))
;
;On status change, send "SC" (status change) HL7 msg to update order
D EN^GMRCHL7(GMRCDFN,+GMRCO,$G(GMRCTYPE),$G(GMRCRB),"SC",GMRCORNP,$G(GMRCVSIT),.GMRCOM)
Q
;
STATUS ;Update the status of a consult that has a TIU result
N GMRCAD,GMRCATX,GMRCOA,GMRCOSTS,GMRCOTFN,GMRC,GMRCSF,GMRCLAE,GMRCRSLT,GMRCADUZ,GMRCOADT
D GETOLD
S GMRCORNP=$G(GMRCAUTH) ;author
S GMRCRSLT=GMRCTUFN_";TIU(8925,"
;
;Evaluate whether a complete action is actually an addendum or New note
I GMRCA=10 S GMRCA=$$EVALACT(GMRCOSTS,+GMRCO,GMRCRSLT)
;
;Update the status and last activity field
;Do not change the status if already completed
I GMRCOSTS=2,GMRCSTS=9 S GMRCSTS=2
D STATUS^GMRCP
;
;Update activity log
D AUDIT
;
;Update the last TIU entry modified and add result to result multiple
D ADD^GMRCTIUA(GMRCTUFN,GMRCO)
;
;Update order
S GMRCORNP=$P(^GMR(123,+GMRCO,0),"^",14)
D EN^GMRCHL7(GMRCDFN,+GMRCO,$G(GMRCTYPE),$G(GMRCRB),"RE",GMRCORNP,$G(GMRCVSIT),.GMRCOM)
;
;Send a message
I $$COMPLETE(GMRCA) D
. N GMRCDATA
. S GMRCATX=""
. I GMRCA=14 S GMRCATX="New Note for "
. I GMRCA=13 S GMRCATX="Addendum Added for "
. S GMRCATX=$S((GMRCSF="Y"):"*",1:"")_GMRCATX
. S GMRCORTX=GMRCATX_"Completed Consult "_$$ORTX^GMRCAU(+GMRCO)
. S GMRCDATA=+GMRCO
. S GMRCDATA=GMRCDATA_"|"_$G(GMRCRSLT)
. I $P(GMRC(0),"^",14),$P(GMRC(0),"^",14)'=DUZ S GMRCADUZ($P(GMRC(0),"^",14))=""
. D MSG^GMRCP(GMRCDFN,GMRCORTX,GMRCDATA,23,.GMRCADUZ,0)
. Q
Q
;
GETOLD ;save the old values of status, and the last activity data
;to determine how to update status and TIU activity log
S GMRC(0)=$G(^GMR(123,+GMRCO,0))
S GMRCDFN=$P(GMRC(0),"^",2)
S GMRCSF=$P(GMRC(0),U,19)
S GMRCOSTS=$P(GMRC(0),"^",12) ;status before activity
S GMRCLAE=+$P($G(^GMR(123,+GMRCO,40,0)),U,3) ;last activity entry
S GMRC(40)=$G(^GMR(123,+GMRCO,40,+GMRCLAE,0))
S GMRCOADT=+$P(GMRC(40),U,1) ;last activity entry date
S GMRCOA=$P(GMRC(40),"^",2) ;last activity
S GMRCOTFN=$P(GMRC(40),"^",9) ;last result
Q
;
AUDIT ;Determine appropriate update activity.
;Quit if new activity is same as previous "Incomplete Rpt" activity
I GMRCOTFN=GMRCRSLT,GMRCOA=9,GMRCOA=GMRCA,GMRCOSTS=GMRCSTS Q
;
S GMRCOM=0
S GMRCDT=$$NOW^XLFDT
;Check for overwrite of incomplete rpt activity if the new
;activity occurs within 15 minutes of the last.
S GMRCOADT=$$FMADD^XLFDT(GMRCOADT,0,0,15)
I GMRCOTFN=GMRCRSLT,GMRCOA=9,$$COMPLETE(GMRCA),GMRCDT<GMRCOADT D AUDIT1 Q
D AUDIT^GMRCP Q
Q
;
AUDIT1 ;overwrite last activity
L +^GMR(123,+GMRCO,40):5 I '$T S GMRCUT=1,GMRCERR=1,GMRCERMS="Activity Trail Not filed - Consult In Use By Another User." L -^GMR(123,+GMRCO,40) Q
S DA=$P(^GMR(123,+GMRCO,40,0),"^",3)
D AUDIT1^GMRCP
Q
;
COMPLETE(GMRCA) ;Determine if the action is a complete action (10,13,14)
Q $S(GMRCA=13:1,GMRCA=14:1,GMRCA=10:1,1:0)
;
EVALACT(GMRCOSTS,GMRCO,GMRCRSLT) ;Evaluate complete action based on prev results and sts
N EVALA,GMRCLAE
I '$D(^GMR(123,+GMRCO,50)) Q 10
I GMRCOSTS'=2 Q 10
I '$D(^GMR(123,+GMRCO,50,"B",GMRCRSLT)) Q 14
S EVALA=0,GMRCLAE=+$P($G(^GMR(123,+GMRCO,40,0)),U,3)+1
F S GMRCLAE=$O(^GMR(123,+GMRCO,40,GMRCLAE),-1) Q:'GMRCLAE D Q:+EVALA
. S GMRCLAE(40)=^GMR(123,+GMRCO,40,GMRCLAE,0)
. I $P(GMRCLAE(40),U,9)=GMRCRSLT D
.. I $P(GMRCLAE(40),U,2)=9 S EVALA=14 Q
.. I $$COMPLETE($P(GMRCLAE(40),U,2)) S EVALA=13 Q
I +EVALA Q EVALA
Q 10
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCTIU1 6809 printed Dec 13, 2024@01:47:35 Page 2
GMRCTIU1 ;SLC/JER - More CT/TIU interface modules ;7/9/2003 [7/9/03 1:51pm]
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1,4,21,17,34,46**;DEC 27, 1997;Build 23
+2 ;
+3 ;This routine invokes IA #2693
ROLLBACK(DA,TIUDA) ; Roll-back a CT record when result is deleted or
+1 ;reassigned
+2 ;Disassociate Note logic
+3 ;The action removes the association of a TIU note with a consult.
+4 ;The new CPRS status will change to "ACTIVE", unless one of the
+5 ;remaining notes has a completed status.
+6 ;This action should send an alert to the service notification users.
+7 NEW DIE,DR,GMRCSTS,GMRCA,GMRCO,GMRCOM,GMRCORNP,GMRCDFN,GMRCNODE,GMRCLIST,GMRCD0,GMRCD1,GMRCSF,GMRCADUZ,MSGTOSRV,GMRCATX,GMRCORTX,GMRCSTAR,GMRCERR,ACTDA,ACTREC,GMRCLSCH,GMRCLER,GMRCRBDA,GMRCTDA,GMRCRSLT
+8 SET GMRCNODE=$GET(^GMR(123,+DA,0))
+9 ; If current result has never been posted, no need to roll back
+10 ; Patch GMRC*1*21
+11 IF '+$ORDER(^GMR(123,+DA,50,"B",+TIUDA_";TIU(8925,",0))
QUIT
+12 IF ($PIECE(GMRCNODE,U,20)=TIUDA)
SET DIE="^GMR(123,"
SET DR="16///@"
DO ^DIE
+13 SET GMRCD0=DA
SET GMRCD1=0
FOR
SET GMRCD1=$ORDER(^GMR(123,GMRCD0,50,GMRCD1))
if 'GMRCD1
QUIT
Begin DoDot:1
+14 NEW DA,DIK
+15 if '(TIUDA=+$GET(^GMR(123,GMRCD0,50,GMRCD1,0)))
QUIT
+16 SET DA(1)=GMRCD0
SET DA=GMRCD1
+17 SET DIK="^GMR(123,"_DA(1)_",50,"
+18 DO ^DIK
End DoDot:1
+19 ;
+20 SET GMRCA=12
SET GMRCO=DA
+21 DO GETLIST^GMRCTIUL(DA,2,1,.GMRCLIST)
+22 SET GMRCSTS=9
+23 ;Following if statement and DO block accomplish the following
+24 ;If there are no other associated TIU Docs then
+25 ;Set status to scheduled if it was last status before the TIU doc
+26 ;Set status to pending if it was the last status before the TIU doc
+27 ;Set status to active otherwise
+28 IF '$GET(GMRCLIST(0))
SET GMRCSTS=6
Begin DoDot:1
+29 SET ACTDA=0
SET ACTREC=0
SET GMRCRBDA=0
SET GMRCLER=-1
SET GMRCLSCH=-1
+30 FOR
SET ACTDA=$ORDER(^GMR(123,DA,40,ACTDA))
if -ACTDA=0
QUIT
Begin DoDot:2
+31 SET ACTREC=$GET(^GMR(123,DA,40,ACTDA,0))
+32 IF $PIECE(ACTREC,U,2)=9
IF $PIECE($PIECE(ACTREC,U,9),";",1)=TIUDA
SET GMRCRBDA=ACTDA
+33 IF $PIECE(ACTREC,U,2)=8
SET GMRCLSCH=ACTDA
+34 IF $PIECE(ACTREC,U,2)=11
SET GMRCLER=ACTDA
End DoDot:2
+35 IF GMRCLER'=-1
IF GMRCLER>GMRCLSCH
SET GMRCSTS=5
+36 IF GMRCLSCH'=-1
IF GMRCLSCH>GMRCLER
SET GMRCSTS=8
End DoDot:1
+37 IF '$TEST
SET GMRCD0=""
FOR
SET GMRCD0=$ORDER(^TMP("GMRC50",$JOB,GMRCD0))
if '$LENGTH(GMRCD0)
QUIT
Begin DoDot:1
+38 if (+GMRCD0=TIUDA)
QUIT
+39 SET GMRCD1=0
FOR
SET GMRCD1=$ORDER(^TMP("GMRC50",$JOB,GMRCD0,GMRCD1))
if 'GMRCD1
QUIT
Begin DoDot:2
+40 if ($PIECE($GET(^TMP("GMRC50",$JOB,GMRCD0,GMRCD1)),U,6)="completed")
SET GMRCSTS=2
End DoDot:2
End DoDot:1
+41 if $GET(NOSAVE)
QUIT
+42 ;Make status completed if the Consult was Admin. Completed
+43 SET ACTDA=0
SET ACTREC=0
+44 FOR
SET ACTDA=$ORDER(^GMR(123,DA,40,ACTDA))
if -ACTDA=0
QUIT
Begin DoDot:1
+45 SET ACTREC=$GET(^GMR(123,DA,40,ACTDA,0))
+46 IF $PIECE(ACTREC,U,2)=10
IF $PIECE(ACTREC,U,9)=""
SET GMRCSTS=2
End DoDot:1
+47 DO STATUS^GMRCP
+48 KILL ^TMP("GMRC50",$JOB),^TMP("GMRC50R",$JOB)
+49 ;
+50 SET GMRCOM=0
SET MSGTOSRV=0
SET GMRCRSLT=TIUDA_";TIU(8925,"
DO AUDIT^GMRCP
+51 ;
+52 ;Build message information if status has changed or sig finding="Y"
+53 SET GMRCSF=$PIECE(GMRCNODE,U,19)
+54 IF ($PIECE(GMRCNODE,U,12)=$PIECE($GET(^GMR(123,GMRCO,0)),U,12))
Begin DoDot:1
+55 SET GMRCATX=""
if GMRCSF'="Y"
QUIT
+56 SET GMRCATX="*Removed consult note for "
End DoDot:1
if GMRCATX=""
QUIT
+57 IF '$TEST
SET GMRCATX=$SELECT((GMRCSF="Y"):"*",1:"")_"Reactivated consult, removed note for "
SET MSGTOSRV=1
+58 SET GMRCORNP=$PIECE(GMRCNODE,U,14)
SET GMRCDFN=$PIECE(GMRCNODE,U,2)
+59 SET GMRCORTX=$$ORTX^GMRCAU(GMRCO)
+60 SET GMRCORTX=GMRCATX_GMRCORTX
+61 if ((GMRCORNP)&(GMRCORNP'=DUZ))
SET GMRCADUZ(GMRCORNP)=""
+62 SET GMRCTDA=TIUDA
+63 DO EXTRACT^TIULQ(GMRCTDA,"GMRCSTAR",.GMRCERR,.05)
+64 IF '$GET(GMRCERR)
Begin DoDot:1
+65 IF $GET(GMRCSTAR(GMRCTDA,.05,"I"))'=5
Begin DoDot:2
+66 DO MSG^GMRCP(GMRCDFN,GMRCORTX,+GMRCO,23,.GMRCADUZ,MSGTOSRV)
End DoDot:2
End DoDot:1
+67 if ($PIECE(GMRCNODE,U,12)=$PIECE($GET(^GMR(123,+GMRCO,0)),U,12))
QUIT
+68 ;
+69 ;On status change, send "SC" (status change) HL7 msg to update order
+70 DO EN^GMRCHL7(GMRCDFN,+GMRCO,$GET(GMRCTYPE),$GET(GMRCRB),"SC",GMRCORNP,$GET(GMRCVSIT),.GMRCOM)
+71 QUIT
+72 ;
STATUS ;Update the status of a consult that has a TIU result
+1 NEW GMRCAD,GMRCATX,GMRCOA,GMRCOSTS,GMRCOTFN,GMRC,GMRCSF,GMRCLAE,GMRCRSLT,GMRCADUZ,GMRCOADT
+2 DO GETOLD
+3 ;author
SET GMRCORNP=$GET(GMRCAUTH)
+4 SET GMRCRSLT=GMRCTUFN_";TIU(8925,"
+5 ;
+6 ;Evaluate whether a complete action is actually an addendum or New note
+7 IF GMRCA=10
SET GMRCA=$$EVALACT(GMRCOSTS,+GMRCO,GMRCRSLT)
+8 ;
+9 ;Update the status and last activity field
+10 ;Do not change the status if already completed
+11 IF GMRCOSTS=2
IF GMRCSTS=9
SET GMRCSTS=2
+12 DO STATUS^GMRCP
+13 ;
+14 ;Update activity log
+15 DO AUDIT
+16 ;
+17 ;Update the last TIU entry modified and add result to result multiple
+18 DO ADD^GMRCTIUA(GMRCTUFN,GMRCO)
+19 ;
+20 ;Update order
+21 SET GMRCORNP=$PIECE(^GMR(123,+GMRCO,0),"^",14)
+22 DO EN^GMRCHL7(GMRCDFN,+GMRCO,$GET(GMRCTYPE),$GET(GMRCRB),"RE",GMRCORNP,$GET(GMRCVSIT),.GMRCOM)
+23 ;
+24 ;Send a message
+25 IF $$COMPLETE(GMRCA)
Begin DoDot:1
+26 NEW GMRCDATA
+27 SET GMRCATX=""
+28 IF GMRCA=14
SET GMRCATX="New Note for "
+29 IF GMRCA=13
SET GMRCATX="Addendum Added for "
+30 SET GMRCATX=$SELECT((GMRCSF="Y"):"*",1:"")_GMRCATX
+31 SET GMRCORTX=GMRCATX_"Completed Consult "_$$ORTX^GMRCAU(+GMRCO)
+32 SET GMRCDATA=+GMRCO
+33 SET GMRCDATA=GMRCDATA_"|"_$GET(GMRCRSLT)
+34 IF $PIECE(GMRC(0),"^",14)
IF $PIECE(GMRC(0),"^",14)'=DUZ
SET GMRCADUZ($PIECE(GMRC(0),"^",14))=""
+35 DO MSG^GMRCP(GMRCDFN,GMRCORTX,GMRCDATA,23,.GMRCADUZ,0)
+36 QUIT
End DoDot:1
+37 QUIT
+38 ;
GETOLD ;save the old values of status, and the last activity data
+1 ;to determine how to update status and TIU activity log
+2 SET GMRC(0)=$GET(^GMR(123,+GMRCO,0))
+3 SET GMRCDFN=$PIECE(GMRC(0),"^",2)
+4 SET GMRCSF=$PIECE(GMRC(0),U,19)
+5 ;status before activity
SET GMRCOSTS=$PIECE(GMRC(0),"^",12)
+6 ;last activity entry
SET GMRCLAE=+$PIECE($GET(^GMR(123,+GMRCO,40,0)),U,3)
+7 SET GMRC(40)=$GET(^GMR(123,+GMRCO,40,+GMRCLAE,0))
+8 ;last activity entry date
SET GMRCOADT=+$PIECE(GMRC(40),U,1)
+9 ;last activity
SET GMRCOA=$PIECE(GMRC(40),"^",2)
+10 ;last result
SET GMRCOTFN=$PIECE(GMRC(40),"^",9)
+11 QUIT
+12 ;
AUDIT ;Determine appropriate update activity.
+1 ;Quit if new activity is same as previous "Incomplete Rpt" activity
+2 IF GMRCOTFN=GMRCRSLT
IF GMRCOA=9
IF GMRCOA=GMRCA
IF GMRCOSTS=GMRCSTS
QUIT
+3 ;
+4 SET GMRCOM=0
+5 SET GMRCDT=$$NOW^XLFDT
+6 ;Check for overwrite of incomplete rpt activity if the new
+7 ;activity occurs within 15 minutes of the last.
+8 SET GMRCOADT=$$FMADD^XLFDT(GMRCOADT,0,0,15)
+9 IF GMRCOTFN=GMRCRSLT
IF GMRCOA=9
IF $$COMPLETE(GMRCA)
IF GMRCDT<GMRCOADT
DO AUDIT1
QUIT
+10 DO AUDIT^GMRCP
QUIT
+11 QUIT
+12 ;
AUDIT1 ;overwrite last activity
+1 LOCK +^GMR(123,+GMRCO,40):5
IF '$TEST
SET GMRCUT=1
SET GMRCERR=1
SET GMRCERMS="Activity Trail Not filed - Consult In Use By Another User."
LOCK -^GMR(123,+GMRCO,40)
QUIT
+2 SET DA=$PIECE(^GMR(123,+GMRCO,40,0),"^",3)
+3 DO AUDIT1^GMRCP
+4 QUIT
+5 ;
COMPLETE(GMRCA) ;Determine if the action is a complete action (10,13,14)
+1 QUIT $SELECT(GMRCA=13:1,GMRCA=14:1,GMRCA=10:1,1:0)
+2 ;
EVALACT(GMRCOSTS,GMRCO,GMRCRSLT) ;Evaluate complete action based on prev results and sts
+1 NEW EVALA,GMRCLAE
+2 IF '$DATA(^GMR(123,+GMRCO,50))
QUIT 10
+3 IF GMRCOSTS'=2
QUIT 10
+4 IF '$DATA(^GMR(123,+GMRCO,50,"B",GMRCRSLT))
QUIT 14
+5 SET EVALA=0
SET GMRCLAE=+$PIECE($GET(^GMR(123,+GMRCO,40,0)),U,3)+1
+6 FOR
SET GMRCLAE=$ORDER(^GMR(123,+GMRCO,40,GMRCLAE),-1)
if 'GMRCLAE
QUIT
Begin DoDot:1
+7 SET GMRCLAE(40)=^GMR(123,+GMRCO,40,GMRCLAE,0)
+8 IF $PIECE(GMRCLAE(40),U,9)=GMRCRSLT
Begin DoDot:2
+9 IF $PIECE(GMRCLAE(40),U,2)=9
SET EVALA=14
QUIT
+10 IF $$COMPLETE($PIECE(GMRCLAE(40),U,2))
SET EVALA=13
QUIT
End DoDot:2
End DoDot:1
if +EVALA
QUIT
+11 IF +EVALA
QUIT EVALA
+12 QUIT 10
+13 ;
