source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFCMS01.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1VAFCMS01 ;BP-CIOFO/JRP - ADMISSION RETRANSMISSION;8/3/1998
2 ;;5.3;Registration;**209**;Aug 13, 1993
3 ;
4LISTMAN ;Entry point for ListMan interface to transmit admission data
5 ;Input : None
6 ;Output : None
7 ;
8 N DFN,VALMBEG,VALMEND
9AGAIN ;Get patient
10 S DFN=$$GETDFN()
11 Q:(DFN<0)
12 I ('$D(^DGPM("APTT1",DFN))) W !!,"** No admissions on file **",!! G AGAIN
13 ;Call ListMan
14 D EN^VALM("VAFC ADMISSION TRANSMISSION")
15 ;Done
16 Q
17 ;
18GETDFN() ;Get pointer to PATIENT file (#2)
19 ;Input : None
20 ;Output : DFN - Pointer to PATIENT file (#2)
21 ; -1 - No entry selected
22 ;
23 N DIC,X,Y,DTOUT,DUOUT
24 S DIC="^DPT("
25 S DIC(0)="AEMNQZ"
26 D ^DIC
27 Q +Y
28 ;
29HEADER ;Build header
30 ;Input : DFN - Pointer to PATIENT file (#2)
31 ; VALMEND - Ending date range (FileMan)
32 ; Defaults to Today
33 ; VALMBEG - Beginning date range (FileMan)
34 ; Defaults to VALMEND-45
35 ;Output : VALMHDR(x) = Line of text in header
36 ;Notes : VALMBEG & VALMEND will be defined on ouput
37 ;
38 ;Check input
39 Q:('$G(DFN))
40 Q:('$D(^DPT(DFN)))
41 S VALMEND=$G(VALMEND,$$DT^XLFDT())
42 S VALMBEG=$G(VALMBEG,$$FMADD^XLFDT(VALMEND,-45))
43 ;Declare variables
44 N LINE,TMP,VA,VAPTYP,VAERR
45 D PID^VADPT6
46 Q:(VAERR)
47 S TMP="Admissions for "_$P(^DPT(DFN,0),"^",1)
48 S TMP=TMP_" ("_VA("PID")_")"
49 S LINE=TMP
50 S TMP=$L(LINE)
51 S VALMHDR(1)=$$SETSTR^VALM1(LINE,"",(40-(TMP\2)),TMP)
52 S TMP=$$FMTE^XLFDT(VALMBEG,"1D")
53 S TMP=TMP_" through "_$$FMTE^XLFDT(VALMEND,"1D")
54 S LINE=TMP
55 S TMP=$L(LINE)
56 S VALMHDR(2)=$$SETSTR^VALM1(LINE,"",(40-(TMP\2)),TMP)
57 Q
58 ;
59ENTRY ;Build display list of admissions for given patient in given time frame
60 ;Input : DFN - Pointer to PATIENT file (#2)
61 ; VALMEND - Ending date range (FileMan)
62 ; Defaults to Today
63 ; VALMBEG - Beginning date range (FileMan)
64 ; Defaults to VALMEND-45
65 ;Output : @VALMAR@(x) = Line of text in ListMan display
66 ; @VALMAR@("IDX",x,y) = "" (Index array for entry selection)
67 ;Notes : VALMBEG & VALMEND will be defined on ouput
68 ;
69 ;Check input (strip time from VALMEND & VALMBEG)
70 Q:('$G(DFN))
71 Q:('$D(^DPT(DFN)))
72 S VALMEND=$G(VALMEND,$$DT^XLFDT())
73 S VALMEND=$P(VALMEND,".",1)
74 S VALMBEG=$G(VALMBEG,$$FMADD^XLFDT(VALMEND,-45))
75 S VALMBEG=$P(VALMBEG,".",1)
76 ;Declare variables
77 N MOVEPTR,DATE,MOVENODE,TMP,LINE,ENTRY,NODE,INVBEG
78 D CLEAN^VALM10
79 S VALMCNT=1
80 S VALMBG=1
81 S ENTRY=0
82 S INVBEG=9999999.9999999-VALMBEG
83 S INVBEG=$P(INVBEG,".",1)
84 ;Loop through admissions for patient
85 S DATE=9999999.9999999-VALMEND
86 S DATE=$P(DATE,".",1)
87 F S DATE=+$O(^DGPM("ATID1",DFN,DATE)) Q:(('DATE)!($P(DATE,".",1)>INVBEG)) D
88 .S MOVEPTR=""
89 .F S MOVEPTR=+$O(^DGPM("ATID1",DFN,DATE,MOVEPTR)) Q:('MOVEPTR) D
90 ..S MOVENODE=$G(^DGPM(MOVEPTR,0))
91 ..Q:('(+MOVENODE))
92 ..S LINE=""
93 ..;Increment choice number
94 ..S ENTRY=ENTRY+1
95 ..S LINE=$$SETFLD^VALM1(ENTRY,LINE,"ENTRY")
96 ..;Movement date/time
97 ..S TMP=$$FMTE^XLFDT(+MOVENODE)
98 ..S LINE=$$SETFLD^VALM1(TMP,LINE,"DATE")
99 ..;Movement type
100 ..S TMP=+$P(MOVENODE,"^",4)
101 ..S NODE=$G(^DG(405.1,TMP,0))
102 ..S TMP=$P(NODE,"^",7)
103 ..S:(TMP="") TMP=$P(NODE,"^",1)
104 ..S LINE=$$SETFLD^VALM1(TMP,LINE,"MOVEMENT")
105 ..;Ward
106 ..S TMP=+$P(MOVENODE,"^",6)
107 ..S NODE=$G(^DIC(42,TMP,0))
108 ..S TMP=$P(NODE,"^",1)
109 ..S LINE=$$SETFLD^VALM1(TMP,LINE,"WARD")
110 ..;Add entry to display & index and increment line count
111 ..D SET^VALM10(VALMCNT,LINE,ENTRY)
112 ..S @VALMAR@("INDEX",ENTRY)=MOVEPTR
113 ..S VALMCNT=VALMCNT+1
114 ..Q
115 .Q
116 ;Decrement line count by one
117 S VALMCNT=VALMCNT-1
118 ;No admissions within date range
119 I ('ENTRY) D
120 .S @VALMAR@(1,0)=""
121 .S LINE="** NO ADMISSIONS FOUND WITHIN GIVEN DATE RANGE **"
122 .S:('$D(^DGPM("APTT1",DFN))) LINE="** NO ADMISSIONS ON FILE **"
123 .S TMP=$L(LINE)
124 .S @VALMAR@(2,0)=$$SETSTR^VALM1(LINE,"",(40-(TMP\2)),TMP)
125 .S VALMCNT=1
126 Q
127 ;
128EXIT ;Clean-up ListMan variables
129 D CLEAN^VALM10
130 ;Return to full screen mode
131 D FULL^VALM1
132 Q
133 ;
134 ; --- LISTMAN PROTOCOLS ---
135 ;
136DATE ;Change date range
137 ;Input : Variables set by ListMan
138 ;Output : None
139 ;Notes : VALMBEG & VALMEND will be updated with the new date range
140 ;
141 ;Declare variables
142 N VALMB,OLDBEG,OLDEND
143 ;Remember current date range
144 S OLDBED=VALMBEG
145 S OLDEND=VALMEND
146 ;Switch to full screen mode
147 D FULL^VALM1
148 ;Prompt for new date range (default begin date is T-45)
149 S VALMB=$$FMADD^XLFDT($$DT^XLFDT(),-45)
150 D RANGE^VALM1
151 ;New date range not entered
152 I (('VALMBEG)!('VALMEND)) D Q
153 .S VALMBEG=OLDBED
154 .S VALMEND=OLDEND
155 .S VALMBCK="R"
156 ;Rebuild header
157 D HEADER
158 ;Rebuild display
159 D ENTRY
160 ;Done
161 S VALMBCK="R"
162 Q
163 ;
164XMIT ;Select and transmit admission from list
165 ;Input : Variables set by ListMan
166 ; DFN - Pointer to PATIENT file (#2)
167 ;Output : None
168 ;Notes : Entry for selected admission will be found/created in
169 ; ADT/HL7 PIVOT file (#391.71) and then transmitted
170 ;
171 ;Declare variables
172 N VALMY,ENTRY,MOVEPTR,PIVOTNUM,PIVOT,DATE,VPTR,DIR,X,Y
173 ;Switch to full screen mode
174 D FULL^VALM1
175 ;Prompt for selection
176 D EN^VALM2(XQORNOD(0),"SO")
177 ;Loop through selections
178 S ENTRY=0
179 F S ENTRY=+$O(VALMY(ENTRY)) Q:('ENTRY) D
180 .;Convert selection number to PATIENT MOVEMENT file pointer
181 .S MOVEPTR=+$G(@VALMAR@("INDEX",ENTRY))
182 .;Get date/time of admission
183 .S DATE=+$G(^DGPM(MOVEPTR,0))
184 .I ('DATE) D Q
185 ..W !!,"** UNABLE TO TRANSMIT ENTRY NUMBER ",ENTRY," **"
186 ..W !," COULD NOT FIND ENTRY IN PATIENT MOVEMENT FILE"
187 ..W !!
188 ..S DIR(0)="EA",DIR("A")="Press RETURN to continue: " D ^DIR
189 .;Create/find entry in ADT/HL7 PIVOT file (call returns pivot number)
190 .S VPTR=MOVEPTR_";DGPM("
191 .S PIVOTNUM=+$$PIVNW^VAFHPIVT(DFN,DATE,1,VPTR)
192 .I ('PIVOTNUM) D Q
193 ..W !!,"** UNABLE TO TRANSMIT ENTRY NUMBER ",ENTRY," **"
194 ..W !," UNABLE TO CREATE/FIND ENTRY IN ADT/HL7 PIVOT FILE"
195 ..W !!
196 ..S DIR(0)="EA",DIR("A")="Press RETURN to continue: " D ^DIR
197 .;Convert pivot number to pointer
198 .S PIVOTPTR=+$O(^VAT(391.71,"D",PIVOTNUM,0))
199 .I ('PIVOTPTR) D Q
200 ..W !!,"** UNABLE TO TRANSMIT ENTRY NUMBER ",ENTRY," **"
201 ..W !," COULD NOT FIND ENTRY IN ADT/HL7 PIVOT FILE"
202 ..W !!
203 ..S DIR(0)="EA",DIR("A")="Press RETURN to continue: " D ^DIR
204 .;Queue retransmission
205 .D RETRAN^VAFCMS02(PIVOTPTR)
206 .W !,"Entry number ",ENTRY," queued for transmission"
207 .S DIR(0)="EA",DIR("A")="Press RETURN to continue: " D ^DIR
208 S VALMBCK="R"
209 Q
210 ;
211NEWDFN ;Change patient
212 ;Input : Variables set by ListMan
213 ; DFN - Pointer to PATIENT file (#2)
214 ;Output : None
215 ;Notes : DFN will be updated with the newly selected patient
216 ; : VALMBEG & VALMEND will not be modified
217 ;
218 ;Declare variables
219 N OLDDFN
220 ;Switch to full screen mode
221 D FULL^VALM1
222 ;Remember current DFN
223 S OLDDFN=DFN
224 ;Prompt for patient
225 S DFN=$$GETDFN()
226 ;New patient not selected
227 I (DFN<0) S DFN=OLDDFN S VALMBCK="R" Q
228 ;Rebuild header
229 D HEADER
230 ;Rebuild display
231 D ENTRY
232 ;Done
233 S VALMBCK="R"
234 Q
Note: See TracBrowser for help on using the repository browser.