GMRCASF ;SLC/DLT - Significant Findings Action ;7/11/03 13:28
;;3.0;CONSULT/REQUEST TRACKING;**4,10,14,22,29,35,46**;DEC 27, 1997;Build 23
SF(GMRCO) ;Evaluate Significant Findings and update accordingly
;GMRCO is the selected consult
N GMRCQIT,GMRCLCK
I '$L($G(GMRCO)) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
I '+($G(GMRCO)) D END Q
I $P($G(^GMR(123,GMRCO,12)),U,5)="P" D Q
. N DIR
. W !,"The requesting facility may not take this action on an "
. W "inter-facility consult."
. S DIR(0)="E" D ^DIR
. D END
I '$$LOCK^GMRCA1(GMRCO) D END Q
S GMRCLCK=1
;
I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
N GMRC,GMRCSTS,GMRCSF,GMRCSFO,GMRCORTX,GMRCDR
S GMRC(0)=$G(^GMR(123,+GMRCO,0)) Q:GMRC(0)=""
;
S GMRCSFO=$P(GMRC(0),"^",19)
W !!,"Current Significant Findings = "_$S(GMRCSFO="U":"Unknown",GMRCSFO="Y":"Yes",GMRCSFO="N":"No",1:"not entered yet"),!!
S GMRCSF=$$GETSIGF(GMRCSFO)
I GMRCSF=0 D END Q
; If no change in old and new value ask if should continue
I GMRCSF=GMRCSFO D I 'Y D END Q
. W !,"The old and new Significant Findings are the same."
. N DIR,DA,DTOUT,DUOUT,DIRUT,DIROUT
. S DIR("A")="Do you want to proceed with this action"
. S DIR(0)="Y"
. S DIR("B")="NO"
. D ^DIR
. I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S Y=0 Q
. I Y=0 Q
;
;Update last action and sig findings but don't change the status
S GMRCSTS=$P(GMRC(0),"^",12),GMRCA=4
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 EXAC^GMRCADC(GMRCMSG),END Q
;
;GMRCOM=1 tells AUDIT^GMRCP to do the word-processing logic
;If an actual comment is added, $P(GMRCOM,"^",2)=1 (send alert),
; if not GMRCOM=1 and no '^' exists (do not send alert)
S GMRCOM=1 D AUDIT^GMRCP
I $G(GMRCERR)=1 S GMRCMSG=GMRCERMS D EXAC^GMRCADC(GMRCMSG),END Q
;
I GMRCSTS=2 D EN^GMRCHL7($P(^GMR(123,GMRCO,0),U,2),GMRCO,$G(GMRCTYPE),$G(GMRCRB),"RE",GMRCORNP,$G(GMRCVSIT),,,$G(GMRCAD))
D SETORTX
I GMRCSTS=2 D SENDALRT(GMRCORTX) Q
I +$P(GMRCOM,"^",2) D
. W !,"An alert with the following text will be sent if recipients are selected: "
. W !," "_GMRCORTX_$$ORTX^GMRCAU(+GMRCO)
. W !
. I GMRCSTS'=2 W !,"or the alert will be sent when the order is completed.",!
. I $P($G(^GMR(123,GMRCO,12)),U,5)="F" D
. W !!,"The ordering provider for this inter-facility consult will "
. W "automatically be ",!,"notified.",!
. D PROCALRT^GMRCACMT(GMRCORTX,1,4,GMRCO)
. ;For consults not completed, the original provider may be deleted from
. ;the recipient list for the alert.
D END
Q
;
SETORTX ;Set prefix text for the alert
S GMRCORTX=$S(GMRCSF="N":"No ",GMRCSF="Y":"",1:"Unknown ")
S GMRCORTX=GMRCORTX_"Sig Findings for "_$P($G(^ORD(100.01,+GMRCSTS,0)),"^",2)_" consult " Q
Q
;
SENDALRT(GMRCORTX) ;Send to the requesting provider
N GMRCRP,GMRCADUZ,GMRCDELR
S GMRCRP=$P($G(^GMR(123,+GMRCO,0)),U,14) ;requesting clinician
I +GMRCRP,GMRCRP'=DUZ D
. S GMRCADUZ(+GMRCRP)=""
. W !,"Alert will be sent to Requesting Provider: "_$P($G(^VA(200,+GMRCRP,0)),U,1)
E W !,"No automatic alerts will be sent to the Requesting Provider."
S GMRCDELR=0
D ANDTO^GMRCACMT
D SENDMSG^GMRCACMT(23,+GMRCO)
;Sig Findings uses the CONSULT/REQUEST RESOLUTION (23) notification
Q
;
GETSIGF(GMRCSFO) ;Get the significant findings
;GMRCSFO is the old significant findings value
N DIR,DA,DTOUT,DUOUT,DIRUT,DIROUT
S DIR(0)="123,15"
S DIR("B")=GMRCSFO
S:DIR("B")="" DIR("B")="unknown"
S DIR("A")="Are there significant findings? (Y/N/U)"
D ^DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q 0
Q Y
;
END ;cleanup variables
I $G(GMRCLCK) D UNLOCK^GMRCA1(GMRCO)
K GMRCO,GMRCA,GMRCMSG,GMRCOM,GMRCSEL,GMRCERR,GMRCERMS
I $D(DTOUT)!$D(DIROUT) S GMRCQIT=""
S:$D(^TMP("GMRC",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCASF 3869 printed Oct 16, 2024@17:45:59 Page 2
GMRCASF ;SLC/DLT - Significant Findings Action ;7/11/03 13:28
+1 ;;3.0;CONSULT/REQUEST TRACKING;**4,10,14,22,29,35,46**;DEC 27, 1997;Build 23
SF(GMRCO) ;Evaluate Significant Findings and update accordingly
+1 ;GMRCO is the selected consult
+2 NEW GMRCQIT,GMRCLCK
+3 IF '$LENGTH($GET(GMRCO))
DO SELECT^GMRCA2(.GMRCO)
IF $DATA(GMRCQUT)
DO END
QUIT
+4 IF '+($GET(GMRCO))
DO END
QUIT
+5 IF $PIECE($GET(^GMR(123,GMRCO,12)),U,5)="P"
Begin DoDot:1
+6 NEW DIR
+7 WRITE !,"The requesting facility may not take this action on an "
+8 WRITE "inter-facility consult."
+9 SET DIR(0)="E"
DO ^DIR
+10 DO END
End DoDot:1
QUIT
+11 IF '$$LOCK^GMRCA1(GMRCO)
DO END
QUIT
+12 SET GMRCLCK=1
+13 ;
+14 IF $DATA(IOTM)
IF $DATA(IOBM)
IF $DATA(IOSTBM)
DO FULL^VALM1
+15 NEW GMRC,GMRCSTS,GMRCSF,GMRCSFO,GMRCORTX,GMRCDR
+16 SET GMRC(0)=$GET(^GMR(123,+GMRCO,0))
if GMRC(0)=""
QUIT
+17 ;
+18 SET GMRCSFO=$PIECE(GMRC(0),"^",19)
+19 WRITE !!,"Current Significant Findings = "_$SELECT(GMRCSFO="U":"Unknown",GMRCSFO="Y":"Yes",GMRCSFO="N":"No",1:"not entered yet"),!!
+20 SET GMRCSF=$$GETSIGF(GMRCSFO)
+21 IF GMRCSF=0
DO END
QUIT
+22 ; If no change in old and new value ask if should continue
+23 IF GMRCSF=GMRCSFO
Begin DoDot:1
+24 WRITE !,"The old and new Significant Findings are the same."
+25 NEW DIR,DA,DTOUT,DUOUT,DIRUT,DIROUT
+26 SET DIR("A")="Do you want to proceed with this action"
+27 SET DIR(0)="Y"
+28 SET DIR("B")="NO"
+29 DO ^DIR
+30 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
SET Y=0
QUIT
+31 IF Y=0
QUIT
End DoDot:1
IF 'Y
DO END
QUIT
+32 ;
+33 ;Update last action and sig findings but don't change the status
+34 SET GMRCSTS=$PIECE(GMRC(0),"^",12)
SET GMRCA=4
+35 SET GMRCDR="8////^S X=GMRCSTS;9////^S X=GMRCA;15////^S X=GMRCSF"
+36 DO STATUS^GMRCP
+37 IF $GET(GMRCERR)=1
SET GMRCMSG=GMRCERMS
DO EXAC^GMRCADC(GMRCMSG)
DO END
QUIT
+38 ;
+39 ;GMRCOM=1 tells AUDIT^GMRCP to do the word-processing logic
+40 ;If an actual comment is added, $P(GMRCOM,"^",2)=1 (send alert),
+41 ; if not GMRCOM=1 and no '^' exists (do not send alert)
+42 SET GMRCOM=1
DO AUDIT^GMRCP
+43 IF $GET(GMRCERR)=1
SET GMRCMSG=GMRCERMS
DO EXAC^GMRCADC(GMRCMSG)
DO END
QUIT
+44 ;
+45 IF GMRCSTS=2
DO EN^GMRCHL7($PIECE(^GMR(123,GMRCO,0),U,2),GMRCO,$GET(GMRCTYPE),$GET(GMRCRB),"RE",GMRCORNP,$GET(GMRCVSIT),,,$GET(GMRCAD))
+46 DO SETORTX
+47 IF GMRCSTS=2
DO SENDALRT(GMRCORTX)
QUIT
+48 IF +$PIECE(GMRCOM,"^",2)
Begin DoDot:1
+49 WRITE !,"An alert with the following text will be sent if recipients are selected: "
+50 WRITE !," "_GMRCORTX_$$ORTX^GMRCAU(+GMRCO)
+51 WRITE !
+52 IF GMRCSTS'=2
WRITE !,"or the alert will be sent when the order is completed.",!
+53 IF $PIECE($GET(^GMR(123,GMRCO,12)),U,5)="F"
Begin DoDot:2
End DoDot:2
+54 WRITE !!,"The ordering provider for this inter-facility consult will "
+55 WRITE "automatically be ",!,"notified.",!
+56 DO PROCALRT^GMRCACMT(GMRCORTX,1,4,GMRCO)
+57 ;For consults not completed, the original provider may be deleted from
+58 ;the recipient list for the alert.
End DoDot:1
+59 DO END
+60 QUIT
+61 ;
SETORTX ;Set prefix text for the alert
+1 SET GMRCORTX=$SELECT(GMRCSF="N":"No ",GMRCSF="Y":"",1:"Unknown ")
+2 SET GMRCORTX=GMRCORTX_"Sig Findings for "_$PIECE($GET(^ORD(100.01,+GMRCSTS,0)),"^",2)_" consult "
QUIT
+3 QUIT
+4 ;
SENDALRT(GMRCORTX) ;Send to the requesting provider
+1 NEW GMRCRP,GMRCADUZ,GMRCDELR
+2 ;requesting clinician
SET GMRCRP=$PIECE($GET(^GMR(123,+GMRCO,0)),U,14)
+3 IF +GMRCRP
IF GMRCRP'=DUZ
Begin DoDot:1
+4 SET GMRCADUZ(+GMRCRP)=""
+5 WRITE !,"Alert will be sent to Requesting Provider: "_$PIECE($GET(^VA(200,+GMRCRP,0)),U,1)
End DoDot:1
+6 IF '$TEST
WRITE !,"No automatic alerts will be sent to the Requesting Provider."
+7 SET GMRCDELR=0
+8 DO ANDTO^GMRCACMT
+9 DO SENDMSG^GMRCACMT(23,+GMRCO)
+10 ;Sig Findings uses the CONSULT/REQUEST RESOLUTION (23) notification
+11 QUIT
+12 ;
GETSIGF(GMRCSFO) ;Get the significant findings
+1 ;GMRCSFO is the old significant findings value
+2 NEW DIR,DA,DTOUT,DUOUT,DIRUT,DIROUT
+3 SET DIR(0)="123,15"
+4 SET DIR("B")=GMRCSFO
+5 if DIR("B")=""
SET DIR("B")="unknown"
+6 SET DIR("A")="Are there significant findings? (Y/N/U)"
+7 DO ^DIR
+8 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
QUIT 0
+9 QUIT Y
+10 ;
END ;cleanup variables
+1 IF $GET(GMRCLCK)
DO UNLOCK^GMRCA1(GMRCO)
+2 KILL GMRCO,GMRCA,GMRCMSG,GMRCOM,GMRCSEL,GMRCERR,GMRCERMS
+3 IF $DATA(DTOUT)!$DATA(DIROUT)
SET GMRCQIT=""
+4 if $DATA(^TMP("GMRC",$JOB,"CURRENT","MENU"))
SET XQORM("HIJACK")=^("MENU")
+5 QUIT
