source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCINC.m@ 1432

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

initial load of WorldVistAEHR
File size: 4.7 KB
RevLine 
[613]1GMRCINC ;SLC/JFR - list incomplete IFC transactions ; 2/12/02 15:05
2 ;;3.0;CONSULT/REQUEST TRACKING;**22**;DEC 27, 1997
3EN ; -- main entry point for GMRCIF INCOMPLETE TRANSACTION
4 N DIR,X,Y,DIRUT,DIROUT
5 S DIR(0)="PO^123:EMQ",DIR("A")="Select a consult request"
6 S DIR("?")="Type in the number, date of request or patient name"
7 S DIR("S")="I $D(^GMR(123.6,""AC"",+Y))"
8 D ^DIR
9 I $D(DIRUT) Q
10 I '$D(^GMR(123,+Y,0)) D Q
11 . W !,"There is no such consult request number"
12 . K DIR S DIR(0)="E" D ^DIR
13 S GMRCNUM=+Y
14 D BLD(GMRCNUM)
15 D EN^VALM("GMRC IF INCOMPLETE TRANSACTION")
16 Q
17 ;
18BLD(GMRCDA) ;get list of incomplete IF transactions for a consult #
19 ; Input:
20 ; GMRCDA = ien of consult from file 123
21 ;
22 ; Output:
23 ; some kind of ^TMP( array
24 N GMRCLOG,ACT,ENT,LINE
25 S ACT=0
26 F S ACT=$O(^GMR(123.6,"AC",GMRCDA,ACT)) Q:'ACT D
27 . S ENT=$O(^GMR(123.6,"AC",GMRCDA,ACT,1,0)) Q:'ENT
28 . S GMRCLOG(ACT)=ENT
29 I '$O(GMRCLOG(0)) D Q
30 .S ^TMP("GMRCINC",$J,1,0)="No incomplete transactions for request #"_GMRCDA
31 S GMRCLOG=GMRCLOG($O(GMRCLOG(0)))
32 D EN^GMRCIERR(GMRCLOG,GMRCDA,$O(GMRCLOG(0)),1)
33 M ^TMP("GMRCINC",$J)=^TMP("GMRCIERR",$J)
34 S ACT=0
35 F S ACT=$O(GMRCLOG(ACT)) Q:'ACT D
36 . K ^TMP("GMRCIERR",$J)
37 . S LINE=$O(^TMP("GMRCINC",$J," "),-1)+1
38 . D ACTLG^GMRCIERR(GMRCDA,ACT,GMRCLOG(ACT),.LINE)
39 . I '$D(^TMP("GMRCIERR",$J)) Q
40 . S ^TMP("GMRCINC",$J,"B",ACT)=$O(^TMP("GMRCIERR",$J,0))+1
41 . S LINE=0 F S LINE=$O(^TMP("GMRCIERR",$J,LINE)) Q:'LINE D
42 .. S ^TMP("GMRCINC",$J,LINE+1,0)=^TMP("GMRCIERR",$J,LINE,0)
43 .. Q
44 . Q
45 K ^TMP("GMRCIERR",$J)
46 Q
47 ;
48HDR ; -- header code
49 S VALMHDR(1)="Incomplete transaction(s) for consult#: "_GMRCNUM
50 Q
51 ;
52INIT ; -- init variables and list array
53 N ACT,LIN
54 S VALMBG=1
55 S VALMCNT=$O(^TMP("GMRCINC",$J," "),-1)
56 S ACT=0 F S ACT=$O(^TMP("GMRCINC",$J,"B",ACT)) Q:'ACT D
57 . S LIN=^TMP("GMRCINC",$J,"B",ACT)
58 . D CNTRL^VALM10(LIN,1,14,IORVON,IORVOFF)
59 S VALMBCK="R"
60 Q
61 ;
62HELP ; -- help code
63 S X="?" D DISP^XQORM1 W !!
64 Q
65 ;
66EXIT ; -- exit code
67 K GMRCNUM,GMRCSEL
68 K ^TMP("GMRCINC",$J),^TMP("GMRCS",$J)
69 Q
70 ;
71NEWCSLT ; pick new consult number to check for inc. trans.
72 N DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
73 D FULL^VALM1
74 S DIR(0)="PO^123:EMQ",DIR("A")="Select a new Consult number"
75 S DIR("?")="Type in the number, date of request or patient name"
76 D ^DIR
77 I $D(DIRUT) Q
78 I '$D(^GMR(123,+Y,0)) D Q
79 . W !,"There is no such consult request number"
80 . K DIR S DIR(0)="E" D ^DIR
81 K ^TMP("GMRCINC",$J),^TMP("GMRCS",$J)
82 S GMRCNUM=+Y
83 I '$D(GMRCSEL) D
84 . D BLD(GMRCNUM)
85 . D INIT
86 . D HDR
87 E D
88 . S GMRCSEL=GMRCNUM
89 . K GMRCLOG
90 . D BLD^GMRCITR(GMRCNUM)
91 . I '$O(GMRCLOG(0)) D
92 .. S ^TMP("GMRCINC",$J,1,0)="No transactions for consult#: "_GMRCNUM
93 . E D
94 .. D DATA^GMRCITR(GMRCS)
95 . D HDR^GMRCITR,LM^GMRCITR
96 S VALMCNT=$O(^TMP("GMRCINC",$J," "),-1)
97 S VALMBG=1
98 Q
99 ;
100RETRAN ;resend a particular transaction
101 N DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y,GMRCACT
102 D FULL^VALM1
103 S GMRCACT=$$SELACT(GMRCNUM) I 'GMRCACT Q
104 I $O(^GMR(123.6,"AC",GMRCNUM,GMRCACT),-1)>0 D Q
105 . W !!,"There is at least one earlier incomplete transaction for this"
106 . W !,"consult, all incomplete transactions should be processed in "
107 . W !,"order.",!
108 . S DIR(0)="E" D ^DIR
109 W !
110 S DIR(0)="YA"
111 S DIR("A")="Are you sure you want to retransmit this activity? "
112 S DIR("A",1)="You have selected the following activity:"
113 S DIR("A",2)=$$GET1^DIQ(123.1,$P(^GMR(123,GMRCNUM,40,GMRCACT,0),U,2),.01)_" entered "_$$FMTE^XLFDT($P(^GMR(123,GMRCNUM,40,GMRCACT,0),U))
114 S DIR("A",3)=" "
115 D ^DIR
116 I +Y'=1 Q
117 D DELALRT^GMRCIBKG($O(^GMR(123.6,"AC",GMRCNUM,GMRCACT,1,0)))
118 D TRIGR^GMRCIEVT(GMRCNUM,GMRCACT)
119 S VALMBG=1
120 Q
121 ;
122SELACT(GMRCDA) ;select an incomplete activity
123 N DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y,GMRC40
124 S DIR(0)="N",DIR("A")="Select an activity number" D ^DIR
125 I $D(DIRUT) Q ""
126 S GMRC40=+Y
127 K DIR
128 I '$D(^GMR(123,GMRCDA,40,GMRC40)) D Q ""
129 . W !,"There is no such activity number for consult# "_GMRCNUM
130 . S DIR(0)="E" D ^DIR
131 I '$D(^GMR(123.6,"AC",GMRCDA,GMRC40)) D Q ""
132 . W !,"There is no incomplete IFC transaction for that activity"
133 . S DIR(0)="E" D ^DIR
134 Q GMRC40
135 ;
136MKCOMP ; mark a particular transaction complete
137 N DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y,GMRCACT,FDA,GMRCLOG,GMRCERR
138 D FULL^VALM1
139 S GMRCACT=$$SELACT(GMRCNUM) I 'GMRCACT Q
140 W !
141 S DIR(0)="YA"
142 S DIR("A")="Are you sure you want to mark this activity complete? "
143 S DIR("A",1)="You have selected the following activity:"
144 S DIR("A",2)=$$GET1^DIQ(123.1,$P(^GMR(123,GMRCNUM,40,GMRCACT,0),U,2),.01)_" entered "_$$FMTE^XLFDT($P(^GMR(123,GMRCNUM,40,GMRCACT,0),U))
145 S DIR("A",3)=" "
146 S DIR("A",4)="Use Caution marking a transaction complete!"
147 S DIR("A",5)=" "
148 D ^DIR
149 I +$G(Y)'=1 Q
150 S GMRCLOG=$O(^GMR(123.6,"AC",GMRCNUM,GMRCACT,1,0))
151 I 'GMRCLOG Q
152 S FDA(1,123.6,GMRCLOG_",",.06)="@"
153 D UPDATE^DIE("","FDA(1)",,"GMRCERR")
154 K ^TMP("GMRCINC",$J),^TMP("GMRCS",$J)
155 D BLD(GMRCNUM)
156 D INIT
157 S VALMBG=1
158 Q
Note: See TracBrowser for help on using the repository browser.