GMRCAAC ;SLC/DLT - Administrative Complete action consult logic ;7/16/98 01:47
;;3.0;CONSULT/REQUEST TRACKING;**4,12,53,46**;DEC 27, 1997;Build 23
COMP(GMRCO) ;Clerk action to Complete an order
;GMRCO is the selected consult
K GMRCQUT,GMRCQIT
I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
I '+$G(GMRCO) D END S GMRCQUT=1 Q
;
N GMRC,GMRCSTS,GMRCQUT
S GMRC(0)=$G(^GMR(123,+GMRCO,0)) Q:GMRC(0)=""
;
;Completion action restricted if status is 1,2,or 13
S GMRCSTS=$P(GMRC(0),"^",12)
I $S(GMRCSTS<3:1,GMRCSTS=13:1,1:0) D Q
. N GMRCMSG
. S GMRCMSG="This order has already been "_$S(GMRCSTS=1:"discontinued",GMRCSTS=2:"completed",1:"cancelled")_"!"
. D EXAC^GMRCADC(GMRCMSG)
. S GMRCQUT=1
. D END
;
;Get the provider, activity date, and significant findings
N DFN,ORIFN,ORGY,GMRCSF,GMRCSTS,GMRCA,GMRCDR,GMRCORNP,GMRCAD,GMRCADUZ
S ORGY="",(GMRCIFN,ORIFN)=$P(GMRC(0),"^",3),GMRCORVP=$P(GMRC(0),"^",2)_";DPT("
S DFN=+GMRCORVP
N GETPROV D GETPROV^GMRCAU I $G(GMRCQIT)="Q" D END Q
S GMRCAD=$$GETDT^GMRCUTL1 I GMRCAD="^" S GMRCQIT="Q" D END Q
S GMRCSFO=$P(GMRC(0),"^",19)
S GMRCSF=$$GETSIGF^GMRCASF(GMRCSFO) I GMRCSF=0 D END Q
;
;Update the Activity Log for an audit trail
S GMRCSTS=2,GMRCA=10
N GMRCQUIT S GMRCOM=1 D AUDIT^GMRCP I +$G(GMRCQUIT)=1 Q
I $G(GMRCERR)=1 S GMRCMSG=GMRCERMS D EXAC^GMRCADC(GMRCMSG) Q
;Update status, last action and significant findings
S GMRCDR="8////^S X=GMRCSTS;9////^S X=GMRCA;15////^S X=GMRCSF"
D STATUS^GMRCP
I $G(GMRCERR)=1 S GMRCMSG=GMRCERMS D Q
. N DA,DIK
. D EXAC^GMRCADC(GMRCMSG)
. S DA=$O(^GMR(123,+GMRCO,40,"A"),-1),DA(1)=+GMRCO,DIK="^GMR(123,"_DA(1)_",40," D ^DIK K DIK
;
D EN^GMRCHL7(DFN,GMRCO,$G(GMRCTYPE),$G(GMRCRB),"RE",GMRCORNP,$G(GMRCVSIT),.GMRCOM,,$G(GMRCAD))
S GMRCADUZ=""
I $P(^GMR(123,GMRCO,0),"^",14),$P(^GMR(123,GMRCO,0),"^",14)'=DUZ S GMRCADUZ($P(^(0),"^",14))=""
S GMRCORTX="Completed Consult "_$$ORTX^GMRCAU(GMRCO)_$S(GMRCSF="Y":" with Sig Findings",GMRCSF="N":" with no Sig Findings",1:"")
D MSG^GMRCP($P(^GMR(123,GMRCO,0),"^",2),GMRCORTX,+GMRCO,23,.GMRCADUZ,0)
Q
;
NOUPD ;Exit without making an update
S GMRCMSG="Completion activity ignored."
D EXAC^GMRCADC(GMRCMSG)
Q
END K DUOUT,X,Y,GMRCPL,GMRCPLI,GMRCURG,GMRCURGI,GMRCPRI,XQORM
I '$D(GMRCNM) K GMRCVP
K GMRCDT,GMRCAD,GMRCL,GMRCTYPE
I '$D(GMRCO) S (GMRCO,ORIFN)=""
K GMRCIFN,GMRCMSG,GMRCORTX,GMRCSA,GMRCSTS,GMRCADUZ,STS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCAAC 2447 printed Apr 09, 2024@20:50:16 Page 2
GMRCAAC ;SLC/DLT - Administrative Complete action consult logic ;7/16/98 01:47
+1 ;;3.0;CONSULT/REQUEST TRACKING;**4,12,53,46**;DEC 27, 1997;Build 23
COMP(GMRCO) ;Clerk action to Complete an order
+1 ;GMRCO is the selected consult
+2 KILL GMRCQUT,GMRCQIT
+3 IF '+$GET(GMRCO)
DO SELECT^GMRCA2(.GMRCO)
IF $DATA(GMRCQUT)
DO END
QUIT
+4 IF '+$GET(GMRCO)
DO END
SET GMRCQUT=1
QUIT
+5 ;
+6 NEW GMRC,GMRCSTS,GMRCQUT
+7 SET GMRC(0)=$GET(^GMR(123,+GMRCO,0))
if GMRC(0)=""
QUIT
+8 ;
+9 ;Completion action restricted if status is 1,2,or 13
+10 SET GMRCSTS=$PIECE(GMRC(0),"^",12)
+11 IF $SELECT(GMRCSTS<3:1,GMRCSTS=13:1,1:0)
Begin DoDot:1
+12 NEW GMRCMSG
+13 SET GMRCMSG="This order has already been "_$SELECT(GMRCSTS=1:"discontinued",GMRCSTS=2:"completed",1:"cancelled")_"!"
+14 DO EXAC^GMRCADC(GMRCMSG)
+15 SET GMRCQUT=1
+16 DO END
End DoDot:1
QUIT
+17 ;
+18 ;Get the provider, activity date, and significant findings
+19 NEW DFN,ORIFN,ORGY,GMRCSF,GMRCSTS,GMRCA,GMRCDR,GMRCORNP,GMRCAD,GMRCADUZ
+20 SET ORGY=""
SET (GMRCIFN,ORIFN)=$PIECE(GMRC(0),"^",3)
SET GMRCORVP=$PIECE(GMRC(0),"^",2)_";DPT("
+21 SET DFN=+GMRCORVP
+22 NEW GETPROV
DO GETPROV^GMRCAU
IF $GET(GMRCQIT)="Q"
DO END
QUIT
+23 SET GMRCAD=$$GETDT^GMRCUTL1
IF GMRCAD="^"
SET GMRCQIT="Q"
DO END
QUIT
+24 SET GMRCSFO=$PIECE(GMRC(0),"^",19)
+25 SET GMRCSF=$$GETSIGF^GMRCASF(GMRCSFO)
IF GMRCSF=0
DO END
QUIT
+26 ;
+27 ;Update the Activity Log for an audit trail
+28 SET GMRCSTS=2
SET GMRCA=10
+29 NEW GMRCQUIT
SET GMRCOM=1
DO AUDIT^GMRCP
IF +$GET(GMRCQUIT)=1
QUIT
+30 IF $GET(GMRCERR)=1
SET GMRCMSG=GMRCERMS
DO EXAC^GMRCADC(GMRCMSG)
QUIT
+31 ;Update status, last action and significant findings
+32 SET GMRCDR="8////^S X=GMRCSTS;9////^S X=GMRCA;15////^S X=GMRCSF"
+33 DO STATUS^GMRCP
+34 IF $GET(GMRCERR)=1
SET GMRCMSG=GMRCERMS
Begin DoDot:1
+35 NEW DA,DIK
+36 DO EXAC^GMRCADC(GMRCMSG)
+37 SET DA=$ORDER(^GMR(123,+GMRCO,40,"A"),-1)
SET DA(1)=+GMRCO
SET DIK="^GMR(123,"_DA(1)_",40,"
DO ^DIK
KILL DIK
End DoDot:1
QUIT
+38 ;
+39 DO EN^GMRCHL7(DFN,GMRCO,$GET(GMRCTYPE),$GET(GMRCRB),"RE",GMRCORNP,$GET(GMRCVSIT),.GMRCOM,,$GET(GMRCAD))
+40 SET GMRCADUZ=""
+41 IF $PIECE(^GMR(123,GMRCO,0),"^",14)
IF $PIECE(^GMR(123,GMRCO,0),"^",14)'=DUZ
SET GMRCADUZ($PIECE(^(0),"^",14))=""
+42 SET GMRCORTX="Completed Consult "_$$ORTX^GMRCAU(GMRCO)_$SELECT(GMRCSF="Y":" with Sig Findings",GMRCSF="N":" with no Sig Findings",1:"")
+43 DO MSG^GMRCP($PIECE(^GMR(123,GMRCO,0),"^",2),GMRCORTX,+GMRCO,23,.GMRCADUZ,0)
+44 QUIT
+45 ;
NOUPD ;Exit without making an update
+1 SET GMRCMSG="Completion activity ignored."
+2 DO EXAC^GMRCADC(GMRCMSG)
+3 QUIT
END KILL DUOUT,X,Y,GMRCPL,GMRCPLI,GMRCURG,GMRCURGI,GMRCPRI,XQORM
+1 IF '$DATA(GMRCNM)
KILL GMRCVP
+2 KILL GMRCDT,GMRCAD,GMRCL,GMRCTYPE
+3 IF '$DATA(GMRCO)
SET (GMRCO,ORIFN)=""
+4 KILL GMRCIFN,GMRCMSG,GMRCORTX,GMRCSA,GMRCSTS,GMRCADUZ,STS
+5 QUIT
