- 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 Feb 18, 2025@23:11:50 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