GMRCDIS ;SLC/JFR - LM ROUTINE TO DISASSOCIATE MED RESULTS; 11/5/01 11:20
;;3.0;CONSULT/REQUEST TRACKING;**15,22**;DEC 27, 1997
;
; This routine invokes IA #2324,#3042,#3120
;
EN ;invoke list template
D EN^VALM("GMRC DISASSOC RESULTS")
Q
HDR ;format list template header
N GMRCVTIT
S GMRCVTIT="Procedure/Medicine Resulting"
D HDR^GMRCSLDT
S VALMHDR(2)="Consult No.: "_GMRCO
S VALMHDR(2)=$$SETSTR^VALM1("Associated Medicine Results",VALMHDR(2),30,28)
Q
PHDR ;set protocols into actions
S VALMSG=$$CJ^XLFSTR("Select action or item number ?? for help",80)
S XQORM("M")=3
D SHOW^VALM
S XQORM("#")=$O(^ORD(101,"B","GMRCACT SELECT MED RESULT",0))_"^1:"_VALMCNT
S XQORM("KEY","EX")=$O(^ORD(101,"B","GMRCACT QUIT",0))_"^1"
S XQORM("KEY","Q")=$O(^ORD(101,"B","GMRCACT QUIT",0))_"^1"
S XQORM("KEY","CLOSE")=$O(^ORD(101,"B","GMRCACT QUIT",0))_"^1"
S XQORM("KEY","NX")=$O(^ORD(101,"B","GMRCACT NEXT SCREEN",0))_"^1"
S XQORM("KEY","DM")=$O(^ORD(101,"B","GMRCACT DISASSOC MED RSLT",0))_"^1"
S XQORM("KEY","DR")=$O(^ORD(101,"B","GMRCACT DISPLAY MED RESULT",0))_"^1"
Q
INIT ; set up array into ^TMP("GMRCR",$J,"DT"...
; should already have it
S VALMCNT=$O(^TMP("GMRCR",$J,"DT",999999),-1),VALMBG=1
Q
GETRES(GMRCO) ; get associated MEDICINE results and format
N RES,GMRCMCR,CNT,DATA
S RES=0,CNT=1
F S RES=$O(^GMR(123,GMRCO,50,RES)) Q:'RES D
. I $G(^GMR(123,GMRCO,50,RES,0))'["MCAR" Q
. S GMRCMCR=$$SINGLE^MCAPI(^GMR(123,GMRCO,50,RES,0))
. S DATA=""
. S DATA=$$SETSTR^VALM1(CNT,DATA,2,$L(CNT))
. S DATA=$$SETSTR^VALM1($P(GMRCMCR,U),DATA,6,23)
. S DATA=$$SETSTR^VALM1($P(GMRCMCR,U,6),DATA,30,$L($P(GMRCMCR,U,6)))
. S DATA=$$SETSTR^VALM1($P(GMRCMCR,U,7),DATA,50,$L($P(GMRCMCR,U,7)))
. S ^TMP("GMRCR",$J,"DT",CNT,0)=DATA
. S ^TMP("GMRCR",$J,"DT",CNT,1)=^GMR(123,GMRCO,50,RES,0)
. S CNT=CNT+1
Q
DIS(GMRCO) ;select consult and start disassoc process
N GMRCQUT,GMRCQIT,GMRCSS,GMRCMSG
I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) Q
I '+$G(GMRCO) Q
I '$$LOCK^GMRCA1(GMRCO) Q
S GMRCMSG=$$REMUSR(GMRCO,DUZ) I '+GMRCMSG D Q
. N MSG
. I '$L($P(GMRCMSG,U,2)) D
.. S MSG="You are not authorized to disassociate results."
. D EXAC^GMRCADC($S($D(MSG):MSG,1:$P(GMRCMSG,U,2)))
D GETRES(GMRCO)
D EN
D UNLOCK^GMRCA1(GMRCO)
Q
EXIT ;
K ^TMP("GMRCR",$J,"DT")
Q
EN1(GMRCRSLT) ; select result and verify remove action
I '+$G(^TMP("GMRCR",$J,"DT",1,1)) D Q ;no result there
. D EXAC^GMRCADC("There are no results to remove")
N RESTXT,RESULT,DIR,X,Y,DUOUT,DTOUT,DIROUT
I '$G(ITEM),'$G(GMRCMEDR) D Q:'ITEM
. S ITEM=$$SELECT^GMRCMED(VALMCNT)
. D SET^GMRCMED(ITEM)
I $G(GMRCMEDR) S ITEM=GMRCMEDR
D FULL^VALM1
S RESTXT=$E(^TMP("GMRCR",$J,"DT",ITEM,0),6,80)
S RESULT=^TMP("GMRCR",$J,"DT",ITEM,1) Q:'+RESULT
S DIR(0)="YA",DIR("B")="NO"
S DIR("A",1)="",DIR("A",2)=" "_RESTXT,DIR("A",3)=""
S DIR("A")="Are you sure you want to disassociate this result? "
D ^DIR I Y<1 Q
D REMOVE(GMRCO,RESULT)
Q
REMOVE(GMRCO,RSLT,GMRCAD,GMRCORNP) ;disassociate result
; remove rslt, log actv, update sts, send alerts
; Input:
; GMRCO - ien from file 123
; RSLT - medicine result in var ptr form (e.g. "19;MCAR(691.5,")
; GMRCAD - FM date/time of action (optional)
; GMRCORNP - DUZ of person performing action (optional)
;
N GMRCRES,DIK,DA,GMRCQUT,GMRCQIT
S GMRCRES=$O(^GMR(123,+GMRCO,50,"B",RSLT,0)) I 'GMRCRES D Q
. D EXAC^GMRCADC("This result is no longer associated with the request")
; delete result entry
S DA(1)=+GMRCO,DA=GMRCRES,DIK="^GMR(123,"_DA(1)_",50," D ^DIK
I $P(^GMR(123,+GMRCO,0),U,15)=RSLT D
. N DA,DIE,DR
. S DIE="^GMR(123,",DA=+GMRCO,DR="11///@" D ^DIE
; update activity tracking
N GMRCA,GMRCRSLT
S GMRCA=12,GMRCRSLT=RSLT
D AUDIT^GMRCP
; Update status back to active if not completed before
N GMRCDFN,GMRCTYP
S GMRCDFN=$P(^GMR(123,+GMRCO,0),U,2)
I $$STSCHG(GMRCO) D
. N GMRCSTS
. S GMRCSTS=6 D STATUS^GMRCP
. ; update CPRS
. S GMRCTYP=$P(^GMR(123,+GMRCO,0),U,17)
. D EN^GMRCHL7(GMRCDFN,+GMRCO,GMRCTYP,"","SC",$G(GMRCORNP),"")
; send notification?
I '$G(GMRCORNP) S GMRCORNP=DUZ
I GMRCORNP'=$P(^GMR(123,+GMRCO,0),U,14) D
. Q:'$P(^GMR(123,+GMRCO,0),U,14)
. N GMRCADUZ,GMRCORTX
. S GMRCADUZ($P(^GMR(123,+GMRCO,0),U,14))=""
. S GMRCORTX="Result removed from "_$$ORTX^GMRCAU(+GMRCO)
. D MSG^GMRCP(GMRCDFN,GMRCORTX,GMRCO,27,.GMRCADUZ,0)
Q
;
STSCHG(GMRCIEN) ;completed before or go back
I $O(^GMR(123,GMRCIEN,50,0)) Q 0 ;still at least one result
I $O(^GMR(123,GMRCIEN,51,0)) Q 0 ;still at least one remote result
N CHG,ACT,I S ACT=0,CHG=1,I=0
F S I=$O(^GMR(123,GMRCIEN,40,I)) Q:'I D
. S ACT(0)=^GMR(123,GMRCIEN,40,I,0),ACT(2)=$G(^(2))
. I $P(ACT(0),U,2)=10,('$L($P(ACT(0),U,9))&('$L($P(ACT(2),U,4)))) D
.. S CHG=0 ; admin completed before if no results
. Q
Q CHG
;
REFRESH(GMRCIEN) ;re-build list of associated results
I $G(GMRCMEDR) D RESETIT^GMRCMED(GMRCMEDR)
K ^TMP("GMRCR",$J,"DT"),GMRCMEDR
D GETRES(GMRCIEN)
I '$O(^TMP("GMRCR",$J,"DT",0)) D
. S ^TMP("GMRCR",$J,"DT",1,0)="No further results to disassociate"
S VALMCNT=$O(^TMP("GMRCR",$J,"DT",""),-1)
S VALMBCK="R"
Q
REMUSR(GMRCIEN,USER) ; check to see if user is authorized to remove results
N GMRCSS,GMRCCLS,RES
I '+$P($G(^GMR(123,GMRCIEN,0)),U,8) Q 0
S GMRCSS=$P(^GMR(123,GMRCIEN,0),U,5) I 'GMRCSS Q 0 ;no service
S GMRCCLS=$P($G(^GMR(123.5,GMRCSS,1)),U,6) I 'GMRCCLS Q 0 ;no class
I '$O(^GMR(123,GMRCIEN,50,0)) Q "0^There are no results associated with this request." ;no results to remove
S RES=""
F S RES=$O(^GMR(123,GMRCIEN,50,"B",RES)) Q:RES="" Q:RES["MCAR"
I RES="" Q "0^There are no Medicine results associated with this request." ;no med results
I '$G(USER) S USER=DUZ
I $$ISA^USRLM(USER,GMRCCLS) Q 1 ;part of USR CLASS in fld 1.06
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCDIS 5876 printed Sep 23, 2025@19:21:27 Page 2
GMRCDIS ;SLC/JFR - LM ROUTINE TO DISASSOCIATE MED RESULTS; 11/5/01 11:20
+1 ;;3.0;CONSULT/REQUEST TRACKING;**15,22**;DEC 27, 1997
+2 ;
+3 ; This routine invokes IA #2324,#3042,#3120
+4 ;
EN ;invoke list template
+1 DO EN^VALM("GMRC DISASSOC RESULTS")
+2 QUIT
HDR ;format list template header
+1 NEW GMRCVTIT
+2 SET GMRCVTIT="Procedure/Medicine Resulting"
+3 DO HDR^GMRCSLDT
+4 SET VALMHDR(2)="Consult No.: "_GMRCO
+5 SET VALMHDR(2)=$$SETSTR^VALM1("Associated Medicine Results",VALMHDR(2),30,28)
+6 QUIT
PHDR ;set protocols into actions
+1 SET VALMSG=$$CJ^XLFSTR("Select action or item number ?? for help",80)
+2 SET XQORM("M")=3
+3 DO SHOW^VALM
+4 SET XQORM("#")=$ORDER(^ORD(101,"B","GMRCACT SELECT MED RESULT",0))_"^1:"_VALMCNT
+5 SET XQORM("KEY","EX")=$ORDER(^ORD(101,"B","GMRCACT QUIT",0))_"^1"
+6 SET XQORM("KEY","Q")=$ORDER(^ORD(101,"B","GMRCACT QUIT",0))_"^1"
+7 SET XQORM("KEY","CLOSE")=$ORDER(^ORD(101,"B","GMRCACT QUIT",0))_"^1"
+8 SET XQORM("KEY","NX")=$ORDER(^ORD(101,"B","GMRCACT NEXT SCREEN",0))_"^1"
+9 SET XQORM("KEY","DM")=$ORDER(^ORD(101,"B","GMRCACT DISASSOC MED RSLT",0))_"^1"
+10 SET XQORM("KEY","DR")=$ORDER(^ORD(101,"B","GMRCACT DISPLAY MED RESULT",0))_"^1"
+11 QUIT
INIT ; set up array into ^TMP("GMRCR",$J,"DT"...
+1 ; should already have it
+2 SET VALMCNT=$ORDER(^TMP("GMRCR",$JOB,"DT",999999),-1)
SET VALMBG=1
+3 QUIT
GETRES(GMRCO) ; get associated MEDICINE results and format
+1 NEW RES,GMRCMCR,CNT,DATA
+2 SET RES=0
SET CNT=1
+3 FOR
SET RES=$ORDER(^GMR(123,GMRCO,50,RES))
if 'RES
QUIT
Begin DoDot:1
+4 IF $GET(^GMR(123,GMRCO,50,RES,0))'["MCAR"
QUIT
+5 SET GMRCMCR=$$SINGLE^MCAPI(^GMR(123,GMRCO,50,RES,0))
+6 SET DATA=""
+7 SET DATA=$$SETSTR^VALM1(CNT,DATA,2,$LENGTH(CNT))
+8 SET DATA=$$SETSTR^VALM1($PIECE(GMRCMCR,U),DATA,6,23)
+9 SET DATA=$$SETSTR^VALM1($PIECE(GMRCMCR,U,6),DATA,30,$LENGTH($PIECE(GMRCMCR,U,6)))
+10 SET DATA=$$SETSTR^VALM1($PIECE(GMRCMCR,U,7),DATA,50,$LENGTH($PIECE(GMRCMCR,U,7)))
+11 SET ^TMP("GMRCR",$JOB,"DT",CNT,0)=DATA
+12 SET ^TMP("GMRCR",$JOB,"DT",CNT,1)=^GMR(123,GMRCO,50,RES,0)
+13 SET CNT=CNT+1
End DoDot:1
+14 QUIT
DIS(GMRCO) ;select consult and start disassoc process
+1 NEW GMRCQUT,GMRCQIT,GMRCSS,GMRCMSG
+2 IF '+$GET(GMRCO)
DO SELECT^GMRCA2(.GMRCO)
IF $DATA(GMRCQUT)
QUIT
+3 IF '+$GET(GMRCO)
QUIT
+4 IF '$$LOCK^GMRCA1(GMRCO)
QUIT
+5 SET GMRCMSG=$$REMUSR(GMRCO,DUZ)
IF '+GMRCMSG
Begin DoDot:1
+6 NEW MSG
+7 IF '$LENGTH($PIECE(GMRCMSG,U,2))
Begin DoDot:2
+8 SET MSG="You are not authorized to disassociate results."
End DoDot:2
+9 DO EXAC^GMRCADC($SELECT($DATA(MSG):MSG,1:$PIECE(GMRCMSG,U,2)))
End DoDot:1
QUIT
+10 DO GETRES(GMRCO)
+11 DO EN
+12 DO UNLOCK^GMRCA1(GMRCO)
+13 QUIT
EXIT ;
+1 KILL ^TMP("GMRCR",$JOB,"DT")
+2 QUIT
EN1(GMRCRSLT) ; select result and verify remove action
+1 ;no result there
IF '+$GET(^TMP("GMRCR",$JOB,"DT",1,1))
Begin DoDot:1
+2 DO EXAC^GMRCADC("There are no results to remove")
End DoDot:1
QUIT
+3 NEW RESTXT,RESULT,DIR,X,Y,DUOUT,DTOUT,DIROUT
+4 IF '$GET(ITEM)
IF '$GET(GMRCMEDR)
Begin DoDot:1
+5 SET ITEM=$$SELECT^GMRCMED(VALMCNT)
+6 DO SET^GMRCMED(ITEM)
End DoDot:1
if 'ITEM
QUIT
+7 IF $GET(GMRCMEDR)
SET ITEM=GMRCMEDR
+8 DO FULL^VALM1
+9 SET RESTXT=$EXTRACT(^TMP("GMRCR",$JOB,"DT",ITEM,0),6,80)
+10 SET RESULT=^TMP("GMRCR",$JOB,"DT",ITEM,1)
if '+RESULT
QUIT
+11 SET DIR(0)="YA"
SET DIR("B")="NO"
+12 SET DIR("A",1)=""
SET DIR("A",2)=" "_RESTXT
SET DIR("A",3)=""
+13 SET DIR("A")="Are you sure you want to disassociate this result? "
+14 DO ^DIR
IF Y<1
QUIT
+15 DO REMOVE(GMRCO,RESULT)
+16 QUIT
REMOVE(GMRCO,RSLT,GMRCAD,GMRCORNP) ;disassociate result
+1 ; remove rslt, log actv, update sts, send alerts
+2 ; Input:
+3 ; GMRCO - ien from file 123
+4 ; RSLT - medicine result in var ptr form (e.g. "19;MCAR(691.5,")
+5 ; GMRCAD - FM date/time of action (optional)
+6 ; GMRCORNP - DUZ of person performing action (optional)
+7 ;
+8 NEW GMRCRES,DIK,DA,GMRCQUT,GMRCQIT
+9 SET GMRCRES=$ORDER(^GMR(123,+GMRCO,50,"B",RSLT,0))
IF 'GMRCRES
Begin DoDot:1
+10 DO EXAC^GMRCADC("This result is no longer associated with the request")
End DoDot:1
QUIT
+11 ; delete result entry
+12 SET DA(1)=+GMRCO
SET DA=GMRCRES
SET DIK="^GMR(123,"_DA(1)_",50,"
DO ^DIK
+13 IF $PIECE(^GMR(123,+GMRCO,0),U,15)=RSLT
Begin DoDot:1
+14 NEW DA,DIE,DR
+15 SET DIE="^GMR(123,"
SET DA=+GMRCO
SET DR="11///@"
DO ^DIE
End DoDot:1
+16 ; update activity tracking
+17 NEW GMRCA,GMRCRSLT
+18 SET GMRCA=12
SET GMRCRSLT=RSLT
+19 DO AUDIT^GMRCP
+20 ; Update status back to active if not completed before
+21 NEW GMRCDFN,GMRCTYP
+22 SET GMRCDFN=$PIECE(^GMR(123,+GMRCO,0),U,2)
+23 IF $$STSCHG(GMRCO)
Begin DoDot:1
+24 NEW GMRCSTS
+25 SET GMRCSTS=6
DO STATUS^GMRCP
+26 ; update CPRS
+27 SET GMRCTYP=$PIECE(^GMR(123,+GMRCO,0),U,17)
+28 DO EN^GMRCHL7(GMRCDFN,+GMRCO,GMRCTYP,"","SC",$GET(GMRCORNP),"")
End DoDot:1
+29 ; send notification?
+30 IF '$GET(GMRCORNP)
SET GMRCORNP=DUZ
+31 IF GMRCORNP'=$PIECE(^GMR(123,+GMRCO,0),U,14)
Begin DoDot:1
+32 if '$PIECE(^GMR(123,+GMRCO,0),U,14)
QUIT
+33 NEW GMRCADUZ,GMRCORTX
+34 SET GMRCADUZ($PIECE(^GMR(123,+GMRCO,0),U,14))=""
+35 SET GMRCORTX="Result removed from "_$$ORTX^GMRCAU(+GMRCO)
+36 DO MSG^GMRCP(GMRCDFN,GMRCORTX,GMRCO,27,.GMRCADUZ,0)
End DoDot:1
+37 QUIT
+38 ;
STSCHG(GMRCIEN) ;completed before or go back
+1 ;still at least one result
IF $ORDER(^GMR(123,GMRCIEN,50,0))
QUIT 0
+2 ;still at least one remote result
IF $ORDER(^GMR(123,GMRCIEN,51,0))
QUIT 0
+3 NEW CHG,ACT,I
SET ACT=0
SET CHG=1
SET I=0
+4 FOR
SET I=$ORDER(^GMR(123,GMRCIEN,40,I))
if 'I
QUIT
Begin DoDot:1
+5 SET ACT(0)=^GMR(123,GMRCIEN,40,I,0)
SET ACT(2)=$GET(^(2))
+6 IF $PIECE(ACT(0),U,2)=10
IF ('$LENGTH($PIECE(ACT(0),U,9))&('$LENGTH($PIECE(ACT(2),U,4))))
Begin DoDot:2
+7 ; admin completed before if no results
SET CHG=0
End DoDot:2
+8 QUIT
End DoDot:1
+9 QUIT CHG
+10 ;
REFRESH(GMRCIEN) ;re-build list of associated results
+1 IF $GET(GMRCMEDR)
DO RESETIT^GMRCMED(GMRCMEDR)
+2 KILL ^TMP("GMRCR",$JOB,"DT"),GMRCMEDR
+3 DO GETRES(GMRCIEN)
+4 IF '$ORDER(^TMP("GMRCR",$JOB,"DT",0))
Begin DoDot:1
+5 SET ^TMP("GMRCR",$JOB,"DT",1,0)="No further results to disassociate"
End DoDot:1
+6 SET VALMCNT=$ORDER(^TMP("GMRCR",$JOB,"DT",""),-1)
+7 SET VALMBCK="R"
+8 QUIT
REMUSR(GMRCIEN,USER) ; check to see if user is authorized to remove results
+1 NEW GMRCSS,GMRCCLS,RES
+2 IF '+$PIECE($GET(^GMR(123,GMRCIEN,0)),U,8)
QUIT 0
+3 ;no service
SET GMRCSS=$PIECE(^GMR(123,GMRCIEN,0),U,5)
IF 'GMRCSS
QUIT 0
+4 ;no class
SET GMRCCLS=$PIECE($GET(^GMR(123.5,GMRCSS,1)),U,6)
IF 'GMRCCLS
QUIT 0
+5 ;no results to remove
IF '$ORDER(^GMR(123,GMRCIEN,50,0))
QUIT "0^There are no results associated with this request."
+6 SET RES=""
+7 FOR
SET RES=$ORDER(^GMR(123,GMRCIEN,50,"B",RES))
if RES=""
QUIT
if RES["MCAR"
QUIT
+8 ;no med results
IF RES=""
QUIT "0^There are no Medicine results associated with this request."
+9 IF '$GET(USER)
SET USER=DUZ
+10 ;part of USR CLASS in fld 1.06
IF $$ISA^USRLM(USER,GMRCCLS)
QUIT 1
+11 QUIT 0
