source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNEUT7.m@ 1000

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1IBCNEUT7 ;DAOU/ALA - IIV MISC. UTILITIES ;11-NOV-2002
2 ;;2.0;INTEGRATED BILLING;**184**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;**Program Description**
6 ; This program contains some general utilities or functions
7 ;
8 Q
9 ;
10RSTA(REC) ; Update status in Response File from Transmission Queue to
11 ; Communication Timeout
12 ; Input Parameters
13 ; REC = IEN from TQ file
14 ; -- Removed 10/29/02 --WCH = Which Record 'P'=Previous, 'C'=Current
15 ; -- if no Which Record passed, it will assume the current one
16 ;
17 N HIEN,RIEN
18 S HIEN=0
19 ; Loop thru HL7 messages associated with the IIV Inquiry
20 F S HIEN=$O(^IBCN(365.1,REC,2,HIEN)) Q:'HIEN D
21 . ; Determine IIV Response associated with the HL7 message
22 . S RIEN=$P($G(^IBCN(365.1,REC,2,HIEN,0)),U,3) Q:'RIEN
23 . ; If IIV Response status is 'Response Received', don't update it
24 . I $P($G(^IBCN(365,RIEN,0)),U,6)=3 Q
25 . ; Update IIV Response status to 'Communication Timeout'
26 . D RSP^IBCNEUT2(RIEN,5)
27 . Q
28 ;
29 Q
30 ;
31TXT(TXT) ;Parse text for wrapping
32 ; Input Parameter
33 ; TXT = The array name
34 ;
35 I '$D(@(TXT)) Q
36 ;
37 K ^UTILITY($J,"W")
38 ;
39 ; Define length of text string; left is 1 and right is 78
40 S DIWF="",DIWL=1,DIWR=78
41 ;
42 ; Format text into scratch file
43 S CT=0
44 F S CT=$O(@(TXT)@(CT)) Q:'CT D
45 . S X=@TXT@(CT) D ^DIWP
46 ;
47 K @(TXT)
48 ;
49 ; Reset formatted text back to array
50 S CT=0
51 F S CT=$O(^UTILITY($J,"W",1,CT)) Q:'CT D
52 . S @(TXT)@(CT)=^UTILITY($J,"W",1,CT,0)
53 ;
54 K ^UTILITY($J,"W"),CT,DIWF,DIWL,DIWR,X,Z,DIW,DIWI,DIWT,DIWTC,DIWX,DN,I
55 Q
56 ;
57ERRN(ARRAY) ; Get the next FileMan error number from the array
58 ; Input
59 ; ARRAY = the array name, include "DIERR"
60 ; Output
61 ; IBEY = the next error number
62 ;
63 ; Example call
64 ; S IERN=$$ERRN^IBCNEUT7("ERROR(""DIERR"")")
65 ;
66 NEW IBEY
67 ;
68 I '$D(@(ARRAY)) S @(ARRAY)=1 Q 1
69 ;
70 S IBEY=$P(@(ARRAY),U,1)
71 S IBEY=IBEY+1,$P(@(ARRAY),U,1)=IBEY
72 Q IBEY
73 ;
Note: See TracBrowser for help on using the repository browser.