source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCITR.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.6 KB
Line 
1GMRCITR ;SLC/JAK - IFC transactions ; 09/27/02 15:50
2 ;;3.0;CONSULT/REQUEST TRACKING;**22,28**;DEC 27, 1997
3EN ; -- main entry point for GMRC IF TRANSACTION
4 N GMRCDAS,GMRCLOG,GMRCQUT,GMRCS,X,Y
5 N GMRCDT1,GMRCDT2,GMRCEDT1,GMRCEDT2
6 D CON I $D(GMRCQUT) D EXIT^GMRCINC Q
7 ;Ask for date range
8 D ^GMRCSPD
9 I $D(GMRCQUT) D EXIT^GMRCINC Q
10 D LISTDATE^GMRCSTU1(GMRCDT1,GMRCDT2,.GMRCEDT1,.GMRCEDT2)
11 D VIEW I $D(GMRCQUT) D EXIT^GMRCINC Q
12 I GMRCSEL="ALL" D
13 . S GMRCNUM=0 F S GMRCNUM=$O(^GMR(123.6,"C",GMRCNUM)) Q:'GMRCNUM D
14 .. D BLD(GMRCNUM)
15 E D
16 . S GMRCNUM=GMRCSEL
17 . D BLD(GMRCNUM)
18 I '$O(GMRCLOG(0)) D
19 . S ^TMP("GMRCINC",$J,1,0)="No transactions for consult#: "_GMRCSEL
20 E D
21 . D DATA(GMRCS)
22 D EN^VALM("GMRC IF TRANSACTION")
23 Q
24 ;
25CON ; ask for consult number or all
26 S GMRCSEL=0
27 F D ASK S:X["^" GMRCQUT=1 Q:X["^" Q:X="ALL" D LKUP Q:GMRCSEL
28 Q
29ASK ; write prompt, do read
30 W !!,"Select Consult/Request Number: ALL// "
31 R X:DTIME
32 I '$T S X="^"
33 I X'["^" S X=$S('$L(X):"ALL",1:X)
34 S:X="ALL" GMRCSEL="ALL"
35 Q
36LKUP ; use value of x for lookup
37 N DIC
38 S DIC="^GMR(123,",DIC(0)="MNEQZ"
39 D ^DIC I '$D(Y(0)) W "...invalid entry"
40 S:Y>0 GMRCSEL=+Y
41 Q
42VIEW ; ask for sort/view
43 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
44 K GMRCQUT
45 ;old code
46 ; S DIR(0)="SA^C:CONSULT;D:DATE;A:ACTIVITY;M:MESSAGE STATUS"
47 ; S DIR("A")="View by (C)onsult, (D)ate, (A)ctivity or (M)essage Status: "
48 ;new code w/ patch 28
49 S DIR(0)="SA^C:CONSULT;D:DATE;A:ACTIVITY"
50 S DIR("A")="View by (C)onsult, (D)ate, or (A)ctivity: "
51 S DIR("B")="Consult"
52 S DIR("?")="Data will be sorted by your selection."
53 D ^DIR I $D(DIRUT) S GMRCQUT=1 Q
54 S GMRCS=Y
55 Q
56BLD(GMRCDA) ; get list of IF transactions for one or all consults
57 ; Input:
58 ; GMRCDA = ien of consult from file 123
59 ;
60 N ACT,ENT,GMRCDTE
61 S ACT=0
62 F S ACT=$O(^GMR(123.6,"C",GMRCDA,ACT)) Q:'ACT D
63 . S ENT=$O(^GMR(123.6,"C",GMRCDA,ACT,0)) Q:'ENT
64 . I $S(GMRCDT1="ALL":0,1:1) D Q:GMRCDTE<GMRCDT1!(GMRCDTE'<GMRCDT2)
65 .. S GMRCDTE=+$P($G(^GMR(123.6,ENT,0)),"^")
66 .. S GMRCDT2=GMRCDT2+1
67 . S GMRCLOG(GMRCDA,ACT)=ENT
68 Q
69DATA(GMRCS) ; get data for IF transaction(s)
70 ; Input:
71 ; GMRCS = sort/view by selection
72 ; Output:
73 ; ^TMP("GMRCINC",$J array
74 N ACT,GMRCSV,TAB
75 I $O(GMRCLOG(0)) D
76 . K GMRCDAS
77 . K ^TMP("GMRCS",$J),^TMP("GMRCINC",$J)
78 S (GMRCDA,LINE)=0
79 S TAB="",$P(TAB," ",30)=""
80 F S GMRCDA=$O(GMRCLOG(GMRCDA)) Q:'GMRCDA D
81 . S ACT=0
82 . F S ACT=$O(GMRCLOG(GMRCDA,ACT)) Q:'ACT D
83 .. S GMRCLOG=$G(GMRCLOG(GMRCDA,ACT)) D
84 ... N ACTTXT,EDT,IERR,STA,GMRCACT,GMRCLOG0
85 ... S GMRCLOG0=$G(^GMR(123.6,GMRCLOG,0)) Q:'GMRCLOG0
86 ... S GMRCDA(0)=$G(^GMR(123,GMRCDA,40,ACT,0)) Q:'GMRCDA(0)
87 ... S LINE=LINE+1
88 ... S X=$P(GMRCLOG0,"^") D REGDTM^GMRCU
89 ... S EDT=$S(X]"":X,1:"No Date/Time")
90 ... S GMRCACT=$P(GMRCDA(0),"^",2)
91 ... S ACTTXT=$P($G(^GMR(123.1,+GMRCACT,0)),"^",1)
92 ... S:'$L(ACTTXT) ACTTXT=GMRCACT_" action?"
93 ... S STA=$P(GMRCLOG0,"^",3),STA=$$MSGSTAT^HLUTIL(STA) ; IA #3098
94 ... S STA=$S(+STA>0:$E($$GET1^DIQ(771.6,+STA,.01),1,22),1:"No Status")
95 ... S IERR=$T(@("ERR"_$P(GMRCLOG0,"^",8)_"^GMRCIUTL"))
96 ... S IERR=$S(IERR]"":$E($P(IERR,";",2),1,45),1:"No Error")
97 ... ;
98 ... S GMRCDAS(GMRCDA)=""
99 ... ; sort data
100 ... S GMRCSV=$S(GMRCS="C":GMRCDA,GMRCS="D":EDT,GMRCS="A":ACTTXT,1:STA)
101 ... S ^TMP("GMRCS",$J,GMRCSV,GMRCLOG)=GMRCDA
102 ... S ^TMP("GMRCS",$J,GMRCSV,GMRCLOG)=^TMP("GMRCS",$J,GMRCSV,GMRCLOG)_$E(TAB,1,13-$L(^(GMRCLOG)))_EDT_$E(TAB,1,5)_ACTTXT
103 ... ;S ^TMP("GMRCS",$J,GMRCSV,GMRCLOG)=^TMP("GMRCS",$J,GMRCSV,GMRCLOG)_$E(TAB,1,56-$L(^(GMRCLOG)))_STA ;msg status not included after patch 28
104 ... S ^TMP("GMRCS",$J,GMRCSV,GMRCLOG)=^TMP("GMRCS",$J,GMRCSV,GMRCLOG)_$E(TAB,1,56-$L(^(GMRCLOG)))_IERR
105 .. Q
106 . ; set data in array name
107 . N GMRC1,LINE
108 . S GMRC1="",LINE=0
109 . F S GMRC1=$O(^TMP("GMRCS",$J,GMRC1)) Q:GMRC1="" D
110 .. N GMRC2
111 .. S GMRC2=""
112 .. F S GMRC2=$O(^TMP("GMRCS",$J,GMRC1,GMRC2)) Q:GMRC2="" D
113 ... S LINE=LINE+1
114 ... S ^TMP("GMRCINC",$J,LINE,0)=$G(^TMP("GMRCS",$J,GMRC1,GMRC2))
115 .. Q
116 . Q
117 Q
118 ;
119HDR ; -- header code
120 S VALMHDR(1)="Transaction(s) for consult#: "_GMRCSEL
121 S VALMHDR(2)="From: "_$G(GMRCEDT1)_" To: "_$G(GMRCEDT2)
122 Q
123LM ; set caption line
124 D CHGCAP^VALM("CAPTION LINE","Consult Entry Date/Time Activity Error")
125 ;D CHGCAP^VALM("CAPTION LINE 1","Error") ; error moved over w/ patch 28
126 Q
127SELECT ; select a consult for detailed display of information
128 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,GMRCDDS
129 K GMRCLOG
130 S DIR(0)="NO^1:9999999^D CKSEL^GMRCITR(X) K:'GMRCDDS X"
131 S DIR("A")="Select a Consult number from the display"
132 S DIR("?")="This response must be a number from the display."
133 D ^DIR I $D(DIRUT) Q
134 K ^TMP("GMRCINC",$J)
135 S GMRCSEL=Y
136 D BLD(GMRCSEL)
137 N ACT,ENT,GMRCND,LINE
138 S (ACT,LINE)=0
139 F S ACT=$O(^GMR(123.6,"C",GMRCSEL,ACT)) Q:'ACT D
140 . S ENT=$O(^GMR(123.6,"C",GMRCSEL,ACT,0)) Q:'ENT D
141 .. Q:'$D(^GMR(123.6,ENT,0))
142 .. N DIC,DR,DA,DIQ,GMRCA
143 .. S DIC="^GMR(123.6,",DR=".01:.08",DA=ENT,DIQ="GMRCA"
144 .. D EN^DIQ1
145 .. S LINE=LINE+1
146 .. S GMRCND="^TMP(""GMRCINC"",$J,LINE,0)"
147 .. S @GMRCND="ENTRY DATE/TIME: "_GMRCA(123.6,ENT,.01),LINE=LINE+1
148 .. S @GMRCND="FACILITY: "_GMRCA(123.6,ENT,.02),LINE=LINE+1
149 .. S @GMRCND="MESSAGE #: "_GMRCA(123.6,ENT,.03),LINE=LINE+1
150 .. S @GMRCND="ACTIVITY #: "_GMRCA(123.6,ENT,.05),LINE=LINE+1
151 .. S @GMRCND="INCOMPLETE: "_GMRCA(123.6,ENT,.06),LINE=LINE+1
152 .. S @GMRCND="TRANS. ATTEMPTS: "_GMRCA(123.6,ENT,.07),LINE=LINE+1
153 .. S @GMRCND="ERROR: "_GMRCA(123.6,ENT,.08),LINE=LINE+1
154 .. S @GMRCND=""
155 S VALMHDR(1)="Detailed Display"
156 S VALMHDR(2)="Consult#: "_GMRCSEL
157 D CHGCAP^VALM("CAPTION LINE","")
158 D CHGCAP^VALM("CAPTION LINE 1","")
159 S VALMCNT=$O(^TMP("GMRCINC",$J," "),-1)
160 S VALMBG=1
161 Q
162CKSEL(X) ; check selection
163 N GMRCDA
164 S (GMRCDA,GMRCDDS)=0
165 F S GMRCDA=$O(GMRCDAS(GMRCDA)) Q:'GMRCDA!GMRCDDS D
166 . I GMRCDA=X S GMRCDDS=1
167 Q
Note: See TracBrowser for help on using the repository browser.