Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCDIS

GMRCDIS.m

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