GMRCP ;SLC/DLT,DCM - Message audit and status process ;Nov 09, 2020@08:52:15
;;3.0;CONSULT/REQUEST TRACKING;**1,4,17,22,27,53,55,46,91,84**;DEC 27, 1997;Build 27
;Processing action on Generic Requests/Consults from OE/RR
MSG(GMRCDFN,GMRCALRM,GMRCIFN,ORN,GMRCADUZ,FLG,GMRCFORC) ;send alert notification information to OERR for notification or update
;GMRCDFN=patient's DFN GMRCORFN=OR file # ^OR(100,GMRCORFN
;GMRCALRM=alert message to be displayed with alert
;GMRCIFN=internal file number of consult in file 123
;GMRCADUZ=set in call to EN^GMRCT=array of providers who will be alerted
;FLG=1 if need to get list of service's providers, 0 if service dc'd.
;GMRCFORC=optional array passed in; users who will be alerted even if alert is turned OFF
;ORN=IFN from file ^ORD(100.9, for consult notification action
N GMRCSS,GMRCORFN
S GMRCORFN=$P(^GMR(123,+GMRCIFN,0),"^",3)
S GMRCSS=$P($G(^GMR(123,+GMRCIFN,0)),"^",5)
I FLG,GMRCSS D EN^GMRCT(GMRCSS)
I $P($G(^GMR(123,+GMRCIFN,12)),U,5)="P" D
. Q:ORN=27 ; don't notify requestor if a new order they placed, duh...
. I DUZ=+$P(^GMR(123,+GMRCIFN,0),U,14) Q ; don;t alert on own actions
. S GMRCADUZ(+$P(^GMR(123,+GMRCIFN,0),U,14))=""
I FLG,$P(^GMR(123,+GMRCIFN,0),"^",11) S GMRCADUZ($P(^(0),"^",11))=""
S:'$D(GMRCADUZ) GMRCADUZ=""
S:'$D(GMRCFORC) GMRCFORC=""
I $G(^GMR(123.5,GMRCSS,"INT"))=1 D ;set ORN to prosthetics alert, if necessary
. S:$G(ORN)=63 ORN=89
;N X S X="" F S X=$O(GMRCADUZ(X)) Q:(X="") I +X=DUZ,X'=DUZ K GMRCADUZ(X) ;Don't send alert to user generating alert
K GMRCADUZ(DUZ) ;Don't send alert to user generating alert
D EN^ORB3(ORN,GMRCDFN,GMRCORFN,.GMRCADUZ,GMRCALRM,GMRCIFN,.GMRCFORC)
Q
AUDIT ;Build processing activity audit trail multiple.
S GMRCDT=$$NOW^XLFDT
AUDIT0 ;alternate entry with date already defined
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:'$D(^GMR(123,+GMRCO,40,0)) ^(0)="^123.02DA^^"
S DA=$S($P(^GMR(123,+GMRCO,40,0),"^",3):$P(^(0),"^",3)+1,1:1)
S $P(^GMR(123,+GMRCO,40,0),"^",3,4)=DA_"^"_DA
AUDIT1 ;entry when the DA is not incremented (INCOMPLETE RPT writeovers)
S GMRCORNP=$G(GMRCORNP) S:'$D(GMRCOM) GMRCOM=0
S GMRCDEV=$G(GMRCDEV),GMRCFF=$G(GMRCFF),GMRCPA=$G(GMRCPA)
S GMRCAD=$S('$D(GMRCAD):GMRCDT,1:GMRCAD)
S GMRCRSLT=$G(GMRCRSLT) ;Added result with GMRC*3.0*4
S DIE="^GMR(123,"_+GMRCO_",40,",DA(1)=+GMRCO
I '$D(^GMR(123,DA(1),40,DA,0)) D
. S DR=".01////^S X=GMRCDT;1////^S X=GMRCA;2////^S X=GMRCAD;3////^S X=GMRCORNP"
. I GMRCA'=22 S DR=DR_";4////^S X=DUZ" ;if it's a print, pkg did it
. S DR=DR_";6////^S X=GMRCFF;7////^S X=GMRCPA;9////^S X=GMRCRSLT;8///^S X=GMRCDEV"
E D
. ;DR string on .01 allows write over, rather than forced new entry
. S DR=".01///^S X=GMRCDT;1////^S X=GMRCA;2////^S X=GMRCAD;3////^S X=GMRCORNP;4////^S X=DUZ;6////^S X=GMRCFF;7////^S X=GMRCPA;9////^S X=GMRCRSLT;8///^S X=GMRCDEV"
;Added result to the DR string
D ^DIE
I +$G(GMRCOM) S GMRCOM(0)=DA D
. W !,"Enter COMMENT..."
. N DIC,DWPK,DWLW,DIWESUB
. S DIC=DIE_DA_",1,",DWPK=1,DWLW=74
. S DIWESUB="COMMENTS" D EN^DIWE
. I $P($G(^GMR(123.1,+$P(^GMR(123,+GMRCO,40,DA,0),U,2),0)),U)="ADDED COMMENT",'$O(^GMR(123,+GMRCO,40,DA,0)) D Q
.. S DA(1)=+GMRCO,DIK="^GMR(123,"_DA(1)_",40," D ^DIK K DIK
.. Q
. I $P($G(^GMR(123.1,+$P(^GMR(123,+GMRCO,40,DA,0),U,2),0)),U)="COMPLETE/UPDATE",$P($G(^GMR(123,+GMRCO,40,DA,0)),U,9)="" D
.. N GMRCMT,GMRCMT1
.. S (GMRCMT,GMRCMT1)=0
.. F S GMRCMT=$O(^GMR(123,+GMRCO,40,DA,1,GMRCMT)) Q:GMRCMT="" D Q:GMRCMT1=1
... I $TR($G(^GMR(123,+GMRCO,40,DA,1,GMRCMT,0))," ","")'="" S GMRCMT1=1
.. I 'GMRCMT1 D G:'GMRCQUIT COMMENT Q
... S GMRCQUIT=0
... W !!,"A comment is required to complete this request!",!
... D WP^DIE(123.02,DA_","_+GMRCO_",",5,,"@")
... K DIR
... S DIR("A")="Type 'Q' to quit or 'C' to continue entering a comment:"
... S DIR("B")="C"
... S DIR(0)="S^C:CONTINUE;Q:QUIT"
... S DIR("?")="Type 'Q' if you would like to abort completion of this Consult/Procedure."
... S DIR("?",1)="Type 'C' or press <RETURN> to re-enter your comments."
... D ^DIR K DIR I Y'="C" S GMRCQUIT=1,DA(1)=+GMRCO,DIK="^GMR(123,"_DA(1)_",40," D ^DIK K DIK
. I '$G(DA) S DA=D0
. I $D(^GMR(123,+GMRCO,40,DA,0)),$O(^GMR(123,+GMRCO,40,DA,0)) S $P(GMRCOM,"^",2)=1
. Q
L -^GMR(123,+GMRCO,40)
; if an IFC, call event handler to generate a msg to remote site
I $D(^GMR(123,GMRCO,12)),$L($P(^(12),U,5)) D
. Q:'$D(^GMR(123,GMRCO,40,DA))
. D TRIGR^GMRCIEVT(GMRCO,DA)
;
K DIE,DA,DR,GMRCDEV,GMRCFF,GMRCPA,X,% Q
;
STATUS ;Update the status for the Request/Consultation File
K GMRCQUT
Q:'$D(GMRCSTS)!('$D(GMRCA))
S DIE=123,DA=+GMRCO
I $D(GMRCDR),$L(GMRCDR) S DR=GMRCDR
E S DR="8////^S X=GMRCSTS;9////^S X=GMRCA"
L +^GMR(123,GMRCO):2 I '$T S GMRCQUT=1,GMRCERR=1,GMRCERMS="Unable to update status and last action - Consult In Use By Another User." Q
D ^DIE
L -^GMR(123,+GMRCO)
K DIE,DA,DR,GMRCDR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCP 5088 printed Sep 23, 2025@19:22:27 Page 2
GMRCP ;SLC/DLT,DCM - Message audit and status process ;Nov 09, 2020@08:52:15
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1,4,17,22,27,53,55,46,91,84**;DEC 27, 1997;Build 27
+2 ;Processing action on Generic Requests/Consults from OE/RR
MSG(GMRCDFN,GMRCALRM,GMRCIFN,ORN,GMRCADUZ,FLG,GMRCFORC) ;send alert notification information to OERR for notification or update
+1 ;GMRCDFN=patient's DFN GMRCORFN=OR file # ^OR(100,GMRCORFN
+2 ;GMRCALRM=alert message to be displayed with alert
+3 ;GMRCIFN=internal file number of consult in file 123
+4 ;GMRCADUZ=set in call to EN^GMRCT=array of providers who will be alerted
+5 ;FLG=1 if need to get list of service's providers, 0 if service dc'd.
+6 ;GMRCFORC=optional array passed in; users who will be alerted even if alert is turned OFF
+7 ;ORN=IFN from file ^ORD(100.9, for consult notification action
+8 NEW GMRCSS,GMRCORFN
+9 SET GMRCORFN=$PIECE(^GMR(123,+GMRCIFN,0),"^",3)
+10 SET GMRCSS=$PIECE($GET(^GMR(123,+GMRCIFN,0)),"^",5)
+11 IF FLG
IF GMRCSS
DO EN^GMRCT(GMRCSS)
+12 IF $PIECE($GET(^GMR(123,+GMRCIFN,12)),U,5)="P"
Begin DoDot:1
+13 ; don't notify requestor if a new order they placed, duh...
if ORN=27
QUIT
+14 ; don;t alert on own actions
IF DUZ=+$PIECE(^GMR(123,+GMRCIFN,0),U,14)
QUIT
+15 SET GMRCADUZ(+$PIECE(^GMR(123,+GMRCIFN,0),U,14))=""
End DoDot:1
+16 IF FLG
IF $PIECE(^GMR(123,+GMRCIFN,0),"^",11)
SET GMRCADUZ($PIECE(^(0),"^",11))=""
+17 if '$DATA(GMRCADUZ)
SET GMRCADUZ=""
+18 if '$DATA(GMRCFORC)
SET GMRCFORC=""
+19 ;set ORN to prosthetics alert, if necessary
IF $GET(^GMR(123.5,GMRCSS,"INT"))=1
Begin DoDot:1
+20 if $GET(ORN)=63
SET ORN=89
End DoDot:1
+21 ;N X S X="" F S X=$O(GMRCADUZ(X)) Q:(X="") I +X=DUZ,X'=DUZ K GMRCADUZ(X) ;Don't send alert to user generating alert
+22 ;Don't send alert to user generating alert
KILL GMRCADUZ(DUZ)
+23 DO EN^ORB3(ORN,GMRCDFN,GMRCORFN,.GMRCADUZ,GMRCALRM,GMRCIFN,.GMRCFORC)
+24 QUIT
AUDIT ;Build processing activity audit trail multiple.
+1 SET GMRCDT=$$NOW^XLFDT
AUDIT0 ;alternate entry with date already defined
+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 if '$DATA(^GMR(123,+GMRCO,40,0))
SET ^(0)="^123.02DA^^"
+3 SET DA=$SELECT($PIECE(^GMR(123,+GMRCO,40,0),"^",3):$PIECE(^(0),"^",3)+1,1:1)
+4 SET $PIECE(^GMR(123,+GMRCO,40,0),"^",3,4)=DA_"^"_DA
AUDIT1 ;entry when the DA is not incremented (INCOMPLETE RPT writeovers)
+1 SET GMRCORNP=$GET(GMRCORNP)
if '$DATA(GMRCOM)
SET GMRCOM=0
+2 SET GMRCDEV=$GET(GMRCDEV)
SET GMRCFF=$GET(GMRCFF)
SET GMRCPA=$GET(GMRCPA)
+3 SET GMRCAD=$SELECT('$DATA(GMRCAD):GMRCDT,1:GMRCAD)
+4 ;Added result with GMRC*3.0*4
SET GMRCRSLT=$GET(GMRCRSLT)
+5 SET DIE="^GMR(123,"_+GMRCO_",40,"
SET DA(1)=+GMRCO
+6 IF '$DATA(^GMR(123,DA(1),40,DA,0))
Begin DoDot:1
+7 SET DR=".01////^S X=GMRCDT;1////^S X=GMRCA;2////^S X=GMRCAD;3////^S X=GMRCORNP"
+8 ;if it's a print, pkg did it
IF GMRCA'=22
SET DR=DR_";4////^S X=DUZ"
+9 SET DR=DR_";6////^S X=GMRCFF;7////^S X=GMRCPA;9////^S X=GMRCRSLT;8///^S X=GMRCDEV"
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 ;DR string on .01 allows write over, rather than forced new entry
+12 SET DR=".01///^S X=GMRCDT;1////^S X=GMRCA;2////^S X=GMRCAD;3////^S X=GMRCORNP;4////^S X=DUZ;6////^S X=GMRCFF;7////^S X=GMRCPA;9////^S X=GMRCRSLT;8///^S X=GMRCDEV"
End DoDot:1
+13 ;Added result to the DR string
+14 DO ^DIE
+1 IF +$GET(GMRCOM)
SET GMRCOM(0)=DA
Begin DoDot:1
+2 WRITE !,"Enter COMMENT..."
+3 NEW DIC,DWPK,DWLW,DIWESUB
+4 SET DIC=DIE_DA_",1,"
SET DWPK=1
SET DWLW=74
+5 SET DIWESUB="COMMENTS"
DO EN^DIWE
+6 IF $PIECE($GET(^GMR(123.1,+$PIECE(^GMR(123,+GMRCO,40,DA,0),U,2),0)),U)="ADDED COMMENT"
IF '$ORDER(^GMR(123,+GMRCO,40,DA,0))
Begin DoDot:2
+7 SET DA(1)=+GMRCO
SET DIK="^GMR(123,"_DA(1)_",40,"
DO ^DIK
KILL DIK
+8 QUIT
End DoDot:2
QUIT
+9 IF $PIECE($GET(^GMR(123.1,+$PIECE(^GMR(123,+GMRCO,40,DA,0),U,2),0)),U)="COMPLETE/UPDATE"
IF $PIECE($GET(^GMR(123,+GMRCO,40,DA,0)),U,9)=""
Begin DoDot:2
+10 NEW GMRCMT,GMRCMT1
+11 SET (GMRCMT,GMRCMT1)=0
+12 FOR
SET GMRCMT=$ORDER(^GMR(123,+GMRCO,40,DA,1,GMRCMT))
if GMRCMT=""
QUIT
Begin DoDot:3
+13 IF $TRANSLATE($GET(^GMR(123,+GMRCO,40,DA,1,GMRCMT,0))," ","")'=""
SET GMRCMT1=1
End DoDot:3
if GMRCMT1=1
QUIT
+14 IF 'GMRCMT1
Begin DoDot:3
+15 SET GMRCQUIT=0
+16 WRITE !!,"A comment is required to complete this request!",!
+17 DO WP^DIE(123.02,DA_","_+GMRCO_",",5,,"@")
+18 KILL DIR
+19 SET DIR("A")="Type 'Q' to quit or 'C' to continue entering a comment:"
+20 SET DIR("B")="C"
+21 SET DIR(0)="S^C:CONTINUE;Q:QUIT"
+22 SET DIR("?")="Type 'Q' if you would like to abort completion of this Consult/Procedure."
+23 SET DIR("?",1)="Type 'C' or press <RETURN> to re-enter your comments."
+24 DO ^DIR
KILL DIR
IF Y'="C"
SET GMRCQUIT=1
SET DA(1)=+GMRCO
SET DIK="^GMR(123,"_DA(1)_",40,"
DO ^DIK
KILL DIK
End DoDot:3
if 'GMRCQUIT
GOTO COMMENT
QUIT
End DoDot:2
+25 IF '$GET(DA)
SET DA=D0
+26 IF $DATA(^GMR(123,+GMRCO,40,DA,0))
IF $ORDER(^GMR(123,+GMRCO,40,DA,0))
SET $PIECE(GMRCOM,"^",2)=1
+27 QUIT
End DoDot:1
+28 LOCK -^GMR(123,+GMRCO,40)
+29 ; if an IFC, call event handler to generate a msg to remote site
+30 IF $DATA(^GMR(123,GMRCO,12))
IF $LENGTH($PIECE(^(12),U,5))
Begin DoDot:1
+31 if '$DATA(^GMR(123,GMRCO,40,DA))
QUIT
+32 DO TRIGR^GMRCIEVT(GMRCO,DA)
End DoDot:1
+33 ;
+34 KILL DIE,DA,DR,GMRCDEV,GMRCFF,GMRCPA,X,%
QUIT
+35 ;
STATUS ;Update the status for the Request/Consultation File
+1 KILL GMRCQUT
+2 if '$DATA(GMRCSTS)!('$DATA(GMRCA))
QUIT
+3 SET DIE=123
SET DA=+GMRCO
+4 IF $DATA(GMRCDR)
IF $LENGTH(GMRCDR)
SET DR=GMRCDR
+5 IF '$TEST
SET DR="8////^S X=GMRCSTS;9////^S X=GMRCA"
+6 LOCK +^GMR(123,GMRCO):2
IF '$TEST
SET GMRCQUT=1
SET GMRCERR=1
SET GMRCERMS="Unable to update status and last action - Consult In Use By Another User."
QUIT
+7 DO ^DIE
+8 LOCK -^GMR(123,+GMRCO)
+9 KILL DIE,DA,DR,GMRCDR
+10 QUIT
