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

GMRCGUIU.m

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