| [613] | 1 | IBCNEUT7 ;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 |  ;
 | 
|---|
 | 10 | RSTA(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 |  ;
 | 
|---|
 | 31 | TXT(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 |  ;
 | 
|---|
 | 57 | ERRN(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 |  ;
 | 
|---|