source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCGUIU.m@ 842

Last change on this file since 842 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.9 KB
Line 
1GMRCGUIU ;SLC/DCM,JFR - Utilities for CPRS GUI ;10/24/01 15:15
2 ;;3.0;CONSULT/REQUEST TRACKING;**4,12,15,17,22**;DEC 27, 1997
3 ;
4 ; This routine invokes IA #2757,#3042,#3122,#3171
5 ;
6GUIC ;Kill variables from GMRCGUIC
7 K GMRC(0),GMRCA,GMRCATN,GMRCD,GMRCDD,GMRCDIAG,GMRCDT,GMRCED,GMRCEDCM
8 K GMRCFL,GMRCFLD,GMRCION,GMRCLNO,GMRCNATO,GMRCNT,GMRCORTX,GMRCPL
9 K GMRCPROC,GMRCRQT,GMRCS38,GMRCSS,GMRCSVC,GMRCTRLC,GMRCTYPE,GMRCURG
10 K GMRCX,LN,GMRCADUZ,ORDG,RMBED,VISIT
11 K GMRCITM,GMRCMSG,GMRCND1,GMRCNOD,GMRCPROV,GMRCOUNT,GMRCGUIF,GMRCREQ
12 K GMRCSS,GMRCPROC,GMRCURG,GMRCURGY,GMRCPL,GMRCATN,GMRCINO,GMRCREQ
13 K GMRCDIAG,GMRCDXCD,GMRCPROV,ND,NDX
14 K XQAKILL,^TMP("GMRCFLD20",$J)
15 Q
16SETDA(GMRCSS,GMRCPROC,GMRCURG,GMRCPL,GMRCATN,GMRCRQT,GMRCION,GMRCDIAG,GMRCDXCD) ;Set DA in ^GMR(123,GMRCO,40
17 N X
18 S X=""
19 I +GMRCSS S X="1////^S X=+GMRCSS;.1///@;"
20 I +GMRCPROC S X=X_"4////^S X=GMRCPROC;.1///@;"
21 I +GMRCURG S X=X_"5////^S X=GMRCURG;"
22 I +GMRCPL S X=X_"6////^S X=GMRCPL;"
23 I +GMRCATN S X=X_"7////^S X=GMRCATN;"
24 I $G(GMRCATN)="@" S X=X_"7///@;"
25 I $L(GMRCION) S X=X_"14///^S X=GMRCION;"
26 I $L(GMRCDIAG) D
27 . I GMRCDIAG="@" S X=X_"30///@;30.1///@;" Q
28 . S X=X_"30////^S X=GMRCDIAG;"
29 I $L(GMRCDXCD) S X=X_"30.1////^S X=GMRCDXCD;"
30 I $L(X) S X=$E(X,1,$L(X)-1)
31 Q X
32 ;
33COMMENT(GMRCO,MSG,ND,GMRCDA) ;File comments from GUI edits
34 N Y,GMRCND
35 S GMRCDA=$$ADDCM^GMRCEDT3(GMRCO),GMRCA=20
36 D AUDIT0^GMRCEDT3(GMRCDA,GMRCO)
37 S Y=$$FMTE^XLFDT(DT,"1D"),GMRCFLD(40)="COMMENT ADDED: "_Y_"^"_GMRCDA
38 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
39 S ^GMR(123,GMRCO,40,GMRCDA,1,0)="^^"_(GMRCNT-1)_"^"_(GMRCNT-1)_"^"_GMRCDT_"^"
40 I $P($G(^GMR(123,GMRCO,12)),U,5)="P" D
41 . D TRIGR^GMRCIEVT(GMRCO,GMRCDA)
42 Q
43 ;
44SENDCOMT(GMRCO,ND1) ;Get comments
45 N NDX,NDY,CMTDT,SENDR,TYPE
46 S NDX=0,CMTDT="",SENDR=""
47 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)=""
48 I $O(TYPE(19,0)) S @GLOBAL@(ND1,0)="~DENY COMMENT",ND1=ND1+1 D
49 .S NDX=0 F S NDX=$O(TYPE(19,NDX)) Q:NDX="" D
50 ..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")
51 ..S @GLOBAL@(ND1,0)="t"_"CANCELLED: "_CMTDT_" BY: "_SENDR,ND1=ND1+1,NDY=0
52 ..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
53 ..S @GLOBAL@(ND1,0)="t",$P(@GLOBAL@(ND1,0),"-",81)="",ND1=ND1+1
54 ..Q
55 .Q
56 S NDX=0 F S NDX=$O(TYPE(20,NDX)) Q:NDX="" S @GLOBAL@(ND1,0)="~ADDED COMMENT",ND1=ND1+1 D
57 .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")
58 .S @GLOBAL@(ND1,0)="t"_"COMMENT on "_CMTDT_" BY: "_SENDR,ND1=ND1+1
59 .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
60 .S @GLOBAL@(ND1,0)="t",$P(@GLOBAL@(ND1,0),"-",81)="",ND1=ND1+1
61 .Q
62 Q
63GETMED(GMRCIFN,GMRCRES) ;return available med results for proc request
64 ; input:
65 ; GMRCIFN - ien from file 123
66 ; GMRCRES - variable passed in by reference used for output
67 ; output:
68 ; GMRCRES(x) = result_name^date^summary^result_ref
69 ; example:
70 ; GMRCRES(1)="19;MCAR(691.5,^EKG^JUN 30,1999@15:52^ABNORMAL"
71 N CNT,ROOT,PROC,S5,DFN,I
72 N MCARCODE,MCARDT,MCESKEY,MCKEYCAR,MCFILE
73 S PROC=+$P($G(^GMR(123,GMRCIFN,0)),U,8)
74 I 'PROC Q ;no procedure there
75 S ROOT=$$GET1^DIQ(697.2,+$P(^GMR(123.3,PROC,0),U,5),1)
76 I '$L(ROOT) Q ;proc not set up for med resulting
77 S S5=ROOT D EN^MCARPS2(+$P(^GMR(123,GMRCIFN,0),U,2))
78 I '$D(^TMP("OR",$J,"MCAR","OT")) Q ;no results available
79 S CNT=0,I=0
80 F S CNT=$O(^TMP("OR",$J,"MCAR","OT",CNT)) Q:'CNT D
81 . N DATA S DATA=^TMP("OR",$J,"MCAR","OT",CNT)
82 . Q:$D(^GMR(123,"R",$P(DATA,U,2)_";"_ROOT_","))
83 . Q:$$SCRNDRFT^GMRCMED($P(DATA,U,2),$P(ROOT,"(",2)) ;screen draft rpts
84 . S I=I+1
85 . S GMRCRES(I)=$P(DATA,U,2)_";"_ROOT_","_U_$P(DATA,U)_U_$P(DATA,U,6,7)
86 . Q
87 K MCARCODE,MCARDT,MCESKEY,MCKEYCAR,MCFILE
88 K ^TMP("OR",$J,"MCAR")
89 Q
90GETRES(GMRCO,GMRCAR) ;return array of associated med rslts
91 ; DBIA #: ?
92 ; Input:
93 ; GMRCO - ien from file 123
94 ; GMRCAR - variable passed by ref to return array in
95 ; Output:
96 ; GMRCAR(x)=result_ref^result_name^date^impression
97 ; Example:
98 ; GMRCAR(1)="19;MCAR(691.5,^EKG^JUN 30,1999@15:52^ABNORMAL"
99 N RES,CNT,DATA
100 S RES=0,CNT=1
101 F S RES=$O(^GMR(123,GMRCO,50,RES)) Q:'RES D
102 . N GMRCMCR,GMRCMCAR,RES0
103 . S RES0=$G(^GMR(123,GMRCO,50,RES,0))
104 . I RES0'["MCAR" Q
105 . S GMRCMCR=$$SINGLE^MCAPI(RES0)
106 . Q:'$L(GMRCMCR)
107 . D MEDLKUP^MCARUTL3(.GMRCMCAR,+$P(RES0,"MCAR(",2),+RES0)
108 . S GMRCAR(CNT)=^GMR(123,GMRCO,50,RES,0)_U
109 . S GMRCAR(CNT)=GMRCAR(CNT)_$P(GMRCMCR,U)_U_$P(GMRCMCR,U,6,7)
110 . I $P(GMRCMCAR,U,10) S GMRCAR(CNT)=GMRCAR(CNT)_"^1"
111 . S CNT=CNT+1
112 . Q
113 Q
114DISPMED(GMRCRES,GMRCAR) ; display a med result
115 ; Input:
116 ; GMRCRES - med result var ptr (e.g. "19;MCAR(691.5")
117 ; GMRCAR - array to return output from medicine API
118 ; Output:
119 ; GMRCAR
120 ; - var passed by ref or as global ref to return text of
121 ; medicine pkg report
122 ; Example: GMRCAR(1)=" PROCEDURE DATE/TIME: 06/30/99 15:52"
123 ; GMRCAR(2)=" CONFIDENTIAL ECG REPORT"
124 ; GMRCAR(3...)=
125 D START^ORWRP(80,"EN^MCAPI(GMRCRES,1)")
126 I '$D(^TMP("ORDATA",$J,1)) D Q
127 . I $D(GMRCAR) S @GMRCAR@(1)="Unable to locate result." Q
128 . I '$D(GMRCAR) S GMRCAR(1)="Unable to locate result."
129 I $D(GMRCAR) M @GMRCAR=^TMP("ORDATA",$J,1)
130 I '$D(GMRCAR) M GMRCAR=^TMP("ORDATA",$J,1)
131 K ^TMP("ORDATA",$J,1)
132 Q
133CANDOMED(GMRCIEN,USER) ;can person associate med results?
134 ; GMRCIEN - ien from file 123
135 N PROC
136 I '$D(^GMR(123,GMRCIEN,0)) Q 0 ;bad record
137 S PROC=+$P(^GMR(123,GMRCIEN,0),U,8) I 'PROC Q 0 ;no procedure
138 I +$G(^GMR(123,GMRCIEN,1)) Q 0 ;med rslts not allowed on CP
139 I '+$P(^GMR(123.3,PROC,0),U,5) Q 0 ;proc not set up
140 Q 1
Note: See TracBrowser for help on using the repository browser.