GMRCGUIU ;SLC/DCM,JFR - Utilities for CPRS GUI ;16-Apr-2014 14:19;DU
;;3.0;CONSULT/REQUEST TRACKING;**4,12,15,17,22,1004**;DEC 27, 1997;Build 12
;
; This routine invokes IA #2757,#3042,#3122,#3171
;
GUIC ;Kill variables from GMRCGUIC
K GMRC(0),GMRCA,GMRCATN,GMRCD,GMRCDD,GMRCDIAG,GMRCDT,GMRCED,GMRCEDCM
K GMRCFL,GMRCFLD,GMRCION,GMRCLNO,GMRCNATO,GMRCNT,GMRCORTX,GMRCPL
K GMRCPROC,GMRCRQT,GMRCS38,GMRCSS,GMRCSVC,GMRCTRLC,GMRCTYPE,GMRCURG
K GMRCX,LN,GMRCADUZ,ORDG,RMBED,VISIT
K GMRCITM,GMRCMSG,GMRCND1,GMRCNOD,GMRCPROV,GMRCOUNT,GMRCGUIF,GMRCREQ
K GMRCSS,GMRCPROC,GMRCURG,GMRCURGY,GMRCPL,GMRCATN,GMRCINO,GMRCREQ
K GMRCDIAG,GMRCDXCD,GMRCPROV,ND,NDX
K XQAKILL,^TMP("GMRCFLD20",$J)
Q
SETDA(GMRCSS,GMRCPROC,GMRCURG,GMRCPL,GMRCATN,GMRCRQT,GMRCION,GMRCDIAG,GMRCDXCD,GMRCPRB) ;Set DA in ^GMR(123,GMRCO,40
N X
S X=""
I +GMRCSS S X="1////^S X=+GMRCSS;.1///@;"
I +GMRCPROC S X=X_"4////^S X=GMRCPROC;.1///@;"
I +GMRCURG S X=X_"5////^S X=GMRCURG;"
I +GMRCPL S X=X_"6////^S X=GMRCPL;"
I +GMRCATN S X=X_"7////^S X=GMRCATN;"
I $G(GMRCATN)="@" S X=X_"7///@;"
I $L(GMRCION) S X=X_"14///^S X=GMRCION;"
I $L(GMRCDIAG) D
. I GMRCDIAG="@" S X=X_"30///@;30.1///@;" Q
. S X=X_"30////^S X=GMRCDIAG;"
I $L(GMRCDXCD) S X=X_"30.1////^S X=GMRCDXCD;"
;IHS/MSC/MGH Patch 1004
I $L(GMRCPRB) S X=X_"9999999.02////^S X=GMRCPRB;"
I $L(X) S X=$E(X,1,$L(X)-1)
Q X
;
N Y,GMRCND
S GMRCDA=$$ADDCM^GMRCEDT3(GMRCO),GMRCA=20
D AUDIT0^GMRCEDT3(GMRCDA,GMRCO)
S Y=$$FMTE^XLFDT(DT,"1D"),GMRCFLD(40)="COMMENT ADDED: "_Y_"^"_GMRCDA
S GMRCND="",GMRCNT=1 F S GMRCND=$O(@MSG@(ND,GMRCND)) Q:GMRCND="" S ^GMR(123,GMRCO,40,GMRCDA,1,GMRCNT,0)=@MSG@(ND,GMRCND),GMRCNT=GMRCNT+1
S ^GMR(123,GMRCO,40,GMRCDA,1,0)="^^"_(GMRCNT-1)_"^"_(GMRCNT-1)_"^"_GMRCDT_"^"
I $P($G(^GMR(123,GMRCO,12)),U,5)="P" D
. D TRIGR^GMRCIEVT(GMRCO,GMRCDA)
Q
;
SENDCOMT(GMRCO,ND1) ;Get comments
N NDX,NDY,CMTDT,SENDR,TYPE
S NDX=0,CMTDT="",SENDR=""
S NDX=0 F S NDX=$O(^GMR(123,GMRCO,40,NDX)) Q:NDX?1A.E!(NDX="") S TYPE=$P(^GMR(123,GMRCO,40,NDX,0),"^",2) I $S(TYPE=19:1,TYPE=20:1,1:0) S TYPE(TYPE,NDX)=""
I $O(TYPE(19,0)) S @GLOBAL@(ND1,0)="~DENY COMMENT",ND1=ND1+1 D
.S NDX=0 F S NDX=$O(TYPE(19,NDX)) Q:NDX="" D
..S CMTDT=$$FMTE^XLFDT($P(^GMR(123,GMRCO,40,NDX,0),"^",1)),SENDR=$S($L($P(^GMR(123,GMRCO,40,NDX,0),"^",4)):$P(^VA(200,$P(^(0),"^",4),0),"^",1),1:"Missing Data")
..S @GLOBAL@(ND1,0)="t"_"CANCELLED: "_CMTDT_" BY: "_SENDR,ND1=ND1+1,NDY=0
..S NDY=0 F S NDY=$O(^GMR(123,GMRCO,40,NDX,1,NDY)) Q:NDY="" S @GLOBAL@(ND1,0)="t"_^GMR(123,GMRCO,40,NDX,1,NDY,0),ND1=ND1+1
..S @GLOBAL@(ND1,0)="t",$P(@GLOBAL@(ND1,0),"-",81)="",ND1=ND1+1
..Q
.Q
S NDX=0 F S NDX=$O(TYPE(20,NDX)) Q:NDX="" S @GLOBAL@(ND1,0)="~ADDED COMMENT",ND1=ND1+1 D
.S CMTDT=$$FMTE^XLFDT($P(^GMR(123,GMRCO,40,NDX,0),"^",1)),SENDR=$S($L($P(^GMR(123,GMRCO,40,NDX,0),"^",4)):$P(^VA(200,$P(^GMR(123,GMRCO,40,NDX,0),"^",4),0),"^",1),1:"UNKNOWN")
.S @GLOBAL@(ND1,0)="t"_"COMMENT on "_CMTDT_" BY: "_SENDR,ND1=ND1+1
.S NDY=0 F S NDY=$O(^GMR(123,GMRCO,40,NDX,1,NDY)) Q:NDY="" S @GLOBAL@(ND,0)="t"_^GMR(123,GMRCO,40,NDX,1,NDY,0),ND1=ND1+1
.S @GLOBAL@(ND1,0)="t",$P(@GLOBAL@(ND1,0),"-",81)="",ND1=ND1+1
.Q
Q
GETMED(GMRCIFN,GMRCRES) ;return available med results for proc request
; input:
; GMRCIFN - ien from file 123
; GMRCRES - variable passed in by reference used for output
; output:
; GMRCRES(x) = result_name^date^summary^result_ref
; example:
; GMRCRES(1)="19;MCAR(691.5,^EKG^JUN 30,1999@15:52^ABNORMAL"
N CNT,ROOT,PROC,S5,DFN,I
N MCARCODE,MCARDT,MCESKEY,MCKEYCAR,MCFILE
S PROC=+$P($G(^GMR(123,GMRCIFN,0)),U,8)
I 'PROC Q ;no procedure there
S ROOT=$$GET1^DIQ(697.2,+$P(^GMR(123.3,PROC,0),U,5),1)
I '$L(ROOT) Q ;proc not set up for med resulting
S S5=ROOT D EN^MCARPS2(+$P(^GMR(123,GMRCIFN,0),U,2))
I '$D(^TMP("OR",$J,"MCAR","OT")) Q ;no results available
S CNT=0,I=0
F S CNT=$O(^TMP("OR",$J,"MCAR","OT",CNT)) Q:'CNT D
. N DATA S DATA=^TMP("OR",$J,"MCAR","OT",CNT)
. Q:$D(^GMR(123,"R",$P(DATA,U,2)_";"_ROOT_","))
. Q:$$SCRNDRFT^GMRCMED($P(DATA,U,2),$P(ROOT,"(",2)) ;screen draft rpts
. S I=I+1
. S GMRCRES(I)=$P(DATA,U,2)_";"_ROOT_","_U_$P(DATA,U)_U_$P(DATA,U,6,7)
. Q
K MCARCODE,MCARDT,MCESKEY,MCKEYCAR,MCFILE
K ^TMP("OR",$J,"MCAR")
Q
GETRES(GMRCO,GMRCAR) ;return array of associated med rslts
; DBIA #: ?
; Input:
; GMRCO - ien from file 123
; GMRCAR - variable passed by ref to return array in
; Output:
; GMRCAR(x)=result_ref^result_name^date^impression
; Example:
; GMRCAR(1)="19;MCAR(691.5,^EKG^JUN 30,1999@15:52^ABNORMAL"
N RES,CNT,DATA
S RES=0,CNT=1
F S RES=$O(^GMR(123,GMRCO,50,RES)) Q:'RES D
. N GMRCMCR,GMRCMCAR,RES0
. S RES0=$G(^GMR(123,GMRCO,50,RES,0))
. I RES0'["MCAR" Q
. S GMRCMCR=$$SINGLE^MCAPI(RES0)
. Q:'$L(GMRCMCR)
. D MEDLKUP^MCARUTL3(.GMRCMCAR,+$P(RES0,"MCAR(",2),+RES0)
. S GMRCAR(CNT)=^GMR(123,GMRCO,50,RES,0)_U
. S GMRCAR(CNT)=GMRCAR(CNT)_$P(GMRCMCR,U)_U_$P(GMRCMCR,U,6,7)
. I $P(GMRCMCAR,U,10) S GMRCAR(CNT)=GMRCAR(CNT)_"^1"
. S CNT=CNT+1
. Q
Q
DISPMED(GMRCRES,GMRCAR) ; display a med result
; Input:
; GMRCRES - med result var ptr (e.g. "19;MCAR(691.5")
; GMRCAR - array to return output from medicine API
; Output:
; GMRCAR
; - var passed by ref or as global ref to return text of
; medicine pkg report
; Example: GMRCAR(1)=" PROCEDURE DATE/TIME: 06/30/99 15:52"
; GMRCAR(2)=" CONFIDENTIAL ECG REPORT"
; GMRCAR(3...)=
D START^ORWRP(80,"EN^MCAPI(GMRCRES,1)")
I '$D(^TMP("ORDATA",$J,1)) D Q
. I $D(GMRCAR) S @GMRCAR@(1)="Unable to locate result." Q
. I '$D(GMRCAR) S GMRCAR(1)="Unable to locate result."
I $D(GMRCAR) M @GMRCAR=^TMP("ORDATA",$J,1)
I '$D(GMRCAR) M GMRCAR=^TMP("ORDATA",$J,1)
K ^TMP("ORDATA",$J,1)
Q
CANDOMED(GMRCIEN,USER) ;can person associate med results?
; GMRCIEN - ien from file 123
N PROC
I '$D(^GMR(123,GMRCIEN,0)) Q 0 ;bad record
S PROC=+$P(^GMR(123,GMRCIEN,0),U,8) I 'PROC Q 0 ;no procedure
I +$G(^GMR(123,GMRCIEN,1)) Q 0 ;med rslts not allowed on CP
I '+$P(^GMR(123.3,PROC,0),U,5) Q 0 ;proc not set up
Q 1
GMRCGUIU ;SLC/DCM,JFR - Utilities for CPRS GUI ;16-Apr-2014 14:19;DU
+1 ;;3.0;CONSULT/REQUEST TRACKING;**4,12,15,17,22,1004**;DEC 27, 1997;Build 12
+2 ;
+3 ; This routine invokes IA #2757,#3042,#3122,#3171
+4 ;
GUIC ;Kill variables from GMRCGUIC
+1 KILL GMRC(0),GMRCA,GMRCATN,GMRCD,GMRCDD,GMRCDIAG,GMRCDT,GMRCED,GMRCEDCM
+2 KILL GMRCFL,GMRCFLD,GMRCION,GMRCLNO,GMRCNATO,GMRCNT,GMRCORTX,GMRCPL
+3 KILL GMRCPROC,GMRCRQT,GMRCS38,GMRCSS,GMRCSVC,GMRCTRLC,GMRCTYPE,GMRCURG
+4 KILL GMRCX,LN,GMRCADUZ,ORDG,RMBED,VISIT
+5 KILL GMRCITM,GMRCMSG,GMRCND1,GMRCNOD,GMRCPROV,GMRCOUNT,GMRCGUIF,GMRCREQ
+6 KILL GMRCSS,GMRCPROC,GMRCURG,GMRCURGY,GMRCPL,GMRCATN,GMRCINO,GMRCREQ
+7 KILL GMRCDIAG,GMRCDXCD,GMRCPROV,ND,NDX
+8 KILL XQAKILL,^TMP("GMRCFLD20",$JOB)
+9 QUIT
SETDA(GMRCSS,GMRCPROC,GMRCURG,GMRCPL,GMRCATN,GMRCRQT,GMRCION,GMRCDIAG,GMRCDXCD,GMRCPRB) ;Set DA in ^GMR(123,GMRCO,40
+1 NEW X
+2 SET X=""
+3 IF +GMRCSS
SET X="1////^S X=+GMRCSS;.1///@;"
+4 IF +GMRCPROC
SET X=X_"4////^S X=GMRCPROC;.1///@;"
+5 IF +GMRCURG
SET X=X_"5////^S X=GMRCURG;"
+6 IF +GMRCPL
SET X=X_"6////^S X=GMRCPL;"
+7 IF +GMRCATN
SET X=X_"7////^S X=GMRCATN;"
+8 IF $GET(GMRCATN)="@"
SET X=X_"7///@;"
+9 IF $LENGTH(GMRCION)
SET X=X_"14///^S X=GMRCION;"
+10 IF $LENGTH(GMRCDIAG)
Begin DoDot:1
+11 IF GMRCDIAG="@"
SET X=X_"30///@;30.1///@;"
QUIT
+12 SET X=X_"30////^S X=GMRCDIAG;"
End DoDot:1
+13 IF $LENGTH(GMRCDXCD)
SET X=X_"30.1////^S X=GMRCDXCD;"
+14 ;IHS/MSC/MGH Patch 1004
+15 IF $LENGTH(GMRCPRB)
SET X=X_"9999999.02////^S X=GMRCPRB;"
+16 IF $LENGTH(X)
SET X=$EXTRACT(X,1,$LENGTH(X)-1)
+17 QUIT X
+18 ;
+1 NEW Y,GMRCND
+2 SET GMRCDA=$$ADDCM^GMRCEDT3(GMRCO)
SET GMRCA=20
+3 DO AUDIT0^GMRCEDT3(GMRCDA,GMRCO)
+4 SET Y=$$FMTE^XLFDT(DT,"1D")
SET GMRCFLD(40)="COMMENT ADDED: "_Y_"^"_GMRCDA
+5 SET GMRCND=""
SET GMRCNT=1
FOR
SET GMRCND=$ORDER(@MSG@(ND,GMRCND))
IF GMRCND=""
QUIT
SET ^GMR(123,GMRCO,40,GMRCDA,1,GMRCNT,0)=@MSG@(ND,GMRCND)
SET GMRCNT=GMRCNT+1
+6 SET ^GMR(123,GMRCO,40,GMRCDA,1,0)="^^"_(GMRCNT-1)_"^"_(GMRCNT-1)_"^"_GMRCDT_"^"
+7 IF $PIECE($GET(^GMR(123,GMRCO,12)),U,5)="P"
Begin DoDot:1
+8 DO TRIGR^GMRCIEVT(GMRCO,GMRCDA)
End DoDot:1
+9 QUIT
+10 ;
SENDCOMT(GMRCO,ND1) ;Get comments
+1 NEW NDX,NDY,CMTDT,SENDR,TYPE
+2 SET NDX=0
SET CMTDT=""
SET SENDR=""
+3 SET NDX=0
FOR
SET NDX=$ORDER(^GMR(123,GMRCO,40,NDX))
IF NDX?1A.E!(NDX="")
QUIT
SET TYPE=$PIECE(^GMR(123,GMRCO,40,NDX,0),"^",2)
IF $SELECT(TYPE=19:1,TYPE=20:1,1:0)
SET TYPE(TYPE,NDX)=""
+4 IF $ORDER(TYPE(19,0))
SET @GLOBAL@(ND1,0)="~DENY COMMENT"
SET ND1=ND1+1
Begin DoDot:1
+5 SET NDX=0
FOR
SET NDX=$ORDER(TYPE(19,NDX))
IF NDX=""
QUIT
Begin DoDot:2
+6 SET CMTDT=$$FMTE^XLFDT($PIECE(^GMR(123,GMRCO,40,NDX,0),"^",1))
SET SENDR=$SELECT($LENGTH($PIECE(^GMR(123,GMRCO,40,NDX,0),"^",4)):$PIECE(^VA(200,$PIECE(^(0),"^",4),0),"^",1),1:"Missing Data")
+7 SET @GLOBAL@(ND1,0)="t"_"CANCELLED: "_CMTDT_" BY: "_SENDR
SET ND1=ND1+1
SET NDY=0
+8 SET NDY=0
FOR
SET NDY=$ORDER(^GMR(123,GMRCO,40,NDX,1,NDY))
IF NDY=""
QUIT
SET @GLOBAL@(ND1,0)="t"_^GMR(123,GMRCO,40,NDX,1,NDY,0)
SET ND1=ND1+1
+9 SET @GLOBAL@(ND1,0)="t"
SET $PIECE(@GLOBAL@(ND1,0),"-",81)=""
SET ND1=ND1+1
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 SET NDX=0
FOR
SET NDX=$ORDER(TYPE(20,NDX))
IF NDX=""
QUIT
SET @GLOBAL@(ND1,0)="~ADDED COMMENT"
SET ND1=ND1+1
Begin DoDot:1
+13 SET CMTDT=$$FMTE^XLFDT($PIECE(^GMR(123,GMRCO,40,NDX,0),"^",1))
SET SENDR=$SELECT($LENGTH($PIECE(^GMR(123,GMRCO,40,NDX,0),"^",4)):$PIECE(^VA(200,$PIECE(^GMR(123,GMRCO,40,NDX,0),"^",4),0),"^",1),1:"UNKNOWN")
+14 SET @GLOBAL@(ND1,0)="t"_"COMMENT on "_CMTDT_" BY: "_SENDR
SET ND1=ND1+1
+15 SET NDY=0
FOR
SET NDY=$ORDER(^GMR(123,GMRCO,40,NDX,1,NDY))
IF NDY=""
QUIT
SET @GLOBAL@(ND,0)="t"_^GMR(123,GMRCO,40,NDX,1,NDY,0)
SET ND1=ND1+1
+16 SET @GLOBAL@(ND1,0)="t"
SET $PIECE(@GLOBAL@(ND1,0),"-",81)=""
SET ND1=ND1+1
+17 QUIT
End DoDot:1
+18 QUIT
GETMED(GMRCIFN,GMRCRES) ;return available med results for proc request
+1 ; input:
+2 ; GMRCIFN - ien from file 123
+3 ; GMRCRES - variable passed in by reference used for output
+4 ; output:
+5 ; GMRCRES(x) = result_name^date^summary^result_ref
+6 ; example:
+7 ; GMRCRES(1)="19;MCAR(691.5,^EKG^JUN 30,1999@15:52^ABNORMAL"
+8 NEW CNT,ROOT,PROC,S5,DFN,I
+9 NEW MCARCODE,MCARDT,MCESKEY,MCKEYCAR,MCFILE
+10 SET PROC=+$PIECE($GET(^GMR(123,GMRCIFN,0)),U,8)
+11 ;no procedure there
IF 'PROC
QUIT
+12 SET ROOT=$$GET1^DIQ(697.2,+$PIECE(^GMR(123.3,PROC,0),U,5),1)
+13 ;proc not set up for med resulting
IF '$LENGTH(ROOT)
QUIT
+14 SET S5=ROOT
DO EN^MCARPS2(+$PIECE(^GMR(123,GMRCIFN,0),U,2))
+15 ;no results available
IF '$DATA(^TMP("OR",$JOB,"MCAR","OT"))
QUIT
+16 SET CNT=0
SET I=0
+17 FOR
SET CNT=$ORDER(^TMP("OR",$JOB,"MCAR","OT",CNT))
IF 'CNT
QUIT
Begin DoDot:1
+18 NEW DATA
SET DATA=^TMP("OR",$JOB,"MCAR","OT",CNT)
+19 IF $DATA(^GMR(123,"R",$PIECE(DATA,U,2)_";"_ROOT_","))
QUIT
+20 ;screen draft rpts
IF $$SCRNDRFT^GMRCMED($PIECE(DATA,U,2),$PIECE(ROOT,"(",2))
QUIT
+21 SET I=I+1
+22 SET GMRCRES(I)=$PIECE(DATA,U,2)_";"_ROOT_","_U_$PIECE(DATA,U)_U_$PIECE(DATA,U,6,7)
+23 QUIT
End DoDot:1
+24 KILL MCARCODE,MCARDT,MCESKEY,MCKEYCAR,MCFILE
+25 KILL ^TMP("OR",$JOB,"MCAR")
+26 QUIT
GETRES(GMRCO,GMRCAR) ;return array of associated med rslts
+1 ; DBIA #: ?
+2 ; Input:
+3 ; GMRCO - ien from file 123
+4 ; GMRCAR - variable passed by ref to return array in
+5 ; Output:
+6 ; GMRCAR(x)=result_ref^result_name^date^impression
+7 ; Example:
+8 ; GMRCAR(1)="19;MCAR(691.5,^EKG^JUN 30,1999@15:52^ABNORMAL"
+9 NEW RES,CNT,DATA
+10 SET RES=0
SET CNT=1
+11 FOR
SET RES=$ORDER(^GMR(123,GMRCO,50,RES))
IF 'RES
QUIT
Begin DoDot:1
+12 NEW GMRCMCR,GMRCMCAR,RES0
+13 SET RES0=$GET(^GMR(123,GMRCO,50,RES,0))
+14 IF RES0'["MCAR"
QUIT
+15 SET GMRCMCR=$$SINGLE^MCAPI(RES0)
+16 IF '$LENGTH(GMRCMCR)
QUIT
+17 DO MEDLKUP^MCARUTL3(.GMRCMCAR,+$PIECE(RES0,"MCAR(",2),+RES0)
+18 SET GMRCAR(CNT)=^GMR(123,GMRCO,50,RES,0)_U
+19 SET GMRCAR(CNT)=GMRCAR(CNT)_$PIECE(GMRCMCR,U)_U_$PIECE(GMRCMCR,U,6,7)
+20 IF $PIECE(GMRCMCAR,U,10)
SET GMRCAR(CNT)=GMRCAR(CNT)_"^1"
+21 SET CNT=CNT+1
+22 QUIT
End DoDot:1
+23 QUIT
DISPMED(GMRCRES,GMRCAR) ; display a med result
+1 ; Input:
+2 ; GMRCRES - med result var ptr (e.g. "19;MCAR(691.5")
+3 ; GMRCAR - array to return output from medicine API
+4 ; Output:
+5 ; GMRCAR
+6 ; - var passed by ref or as global ref to return text of
+7 ; medicine pkg report
+8 ; Example: GMRCAR(1)=" PROCEDURE DATE/TIME: 06/30/99 15:52"
+9 ; GMRCAR(2)=" CONFIDENTIAL ECG REPORT"
+10 ; GMRCAR(3...)=
+11 DO START^ORWRP(80,"EN^MCAPI(GMRCRES,1)")
+12 IF '$DATA(^TMP("ORDATA",$JOB,1))
Begin DoDot:1
+13 IF $DATA(GMRCAR)
SET @GMRCAR@(1)="Unable to locate result."
QUIT
+14 IF '$DATA(GMRCAR)
SET GMRCAR(1)="Unable to locate result."
End DoDot:1
QUIT
+15 IF $DATA(GMRCAR)
MERGE @GMRCAR=^TMP("ORDATA",$JOB,1)
+16 IF '$DATA(GMRCAR)
MERGE GMRCAR=^TMP("ORDATA",$JOB,1)
+17 KILL ^TMP("ORDATA",$JOB,1)
+18 QUIT
CANDOMED(GMRCIEN,USER) ;can person associate med results?
+1 ; GMRCIEN - ien from file 123
+2 NEW PROC
+3 ;bad record
IF '$DATA(^GMR(123,GMRCIEN,0))
QUIT 0
+4 ;no procedure
SET PROC=+$PIECE(^GMR(123,GMRCIEN,0),U,8)
IF 'PROC
QUIT 0
+5 ;med rslts not allowed on CP
IF +$GET(^GMR(123,GMRCIEN,1))
QUIT 0
+6 ;proc not set up
IF '+$PIECE(^GMR(123.3,PROC,0),U,5)
QUIT 0
+7 QUIT 1
