source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBHLZFE.m@ 975

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

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1FBHLZFE ;WCIOFO/SAB-CREATE HL7 ZFE SEGMENTS ;7/21/1998
2 ;;3.5;FEE BASIS;**14,78**;JAN 30, 1995
3 ;
4 ; This routine generates ZFE HL7 segments that contain FEE BASIS
5 ; authorization data for a veteran.
6 ;
7EN(DFN,FBSTR,FBCUT) ; Returns array of ZFE segments containing FEE BASIS
8 ; authorizatiion data for a veteran.
9 ; Input:
10 ; DFN - internal entry number of the PATIENT (#2) file and
11 ; FEE BASIS PATIENT (#161) file
12 ; FBSTR - (optional) comma delimited sting of requested fields
13 ; DEFAULT: "1,2,3,4,5" (returns all fields)
14 ; FBCUT - (optional) cutoff date (fileman format)
15 ; Default: "2961001" (Oct 1, 1996)
16 ; authorizations with a TO DATE prior to the cutoff will
17 ; not be considered.
18 ; Also needs HL7 variables defined (HLFS, HLECH and HLQ)
19 ; Output:
20 ; If an exception did not occur
21 ; FBZFE(I) - an array of string(s) forming the ZFE segments for the
22 ; patient's FEE authorizations that meet the criteria.
23 ; I will be numeric values greater than 0.
24 ; OR undefined if no authorizations meet criteria.
25 ;
26 ; Note: Only the latest authorization for each group is
27 ; returned (where group is FEE PROGRAM + TREATMENT TYPE).
28 ;
29 ; If an exception did occur
30 ; FBZFE(0) = -1 ^ exception number ^ exception text
31 ;
32 N FBA,FBDA1,FBGRP,FBI,FBICN,FBY0
33 K FBZFE ; initialize array
34 I $G(FBSTR)="" S FBSTR="1,2,3,4,5"
35 S FBSTR=","_FBSTR_","
36 I $G(FBCUT)="" S FBCUT=2961001
37 ;
38 ; check for required input
39 I $G(FBZFE(0))'<0 D
40 . I $G(DFN)="" S FBZFE(0)="-1^103^Patient DFN not specified." Q
41 . I '$D(HLFS)!'$D(HLECH)!'$D(HLQ) S FBZFE(0)="-1^201^HL7 variables not defined." Q
42 ;
43 ; get patient ICN
44 I $G(FBZFE(0))'<0 D
45 . I $$IFLOCAL^MPIF001(DFN) S FBZFE(0)="-1^104^ICN could not be determined for the specified patient." Q ; must not be local ICN
46 . S FBICN=$$GETICN^MPIF001(DFN) I FBICN<0 S FBZFE(0)="-1^104^ICN could not be determined for the specified patient." Q
47 ;
48 ; check if cutoff date is a valid value
49 I $G(FBZFE(0))'<0 D
50 . I FBCUT'?7N S FBZFE(0)="-1^101^Valid date not specified." Q
51 . I $$FMTHL7^XLFDT(FBCUT)<0 S FBZFE(0)="-1^101^Valid date not specified." Q
52 ;
53 I $G(FBZFE(0))'<0 D
54 . ; find authorizations that meet criteria (if any)
55 . ; loop thru authorizations
56 . S FBDA1=0 F S FBDA1=$O(^FBAAA(DFN,1,FBDA1)) Q:'FBDA1 D
57 . . Q:$P($G(^FBAAA(DFN,1,FBDA1,"ADEL")),U)="Y" ; ignore Austin Deleted
58 . . S FBY0=$G(^FBAAA(DFN,1,FBDA1,0))
59 . . Q:$P(FBY0,U,3)="" ; FEE Program required
60 . . Q:$P(FBY0,U,2)<FBCUT ; before cutoff date
61 . . S FBGRP=$P(FBY0,U,3)_U_$P(FBY0,U,13) ; group (Program + Treat. Type)
62 . . Q:$P(FBY0,U,2)'>$P($G(FBA(FBGRP)),U,2) ; already have later for grp
63 . . ; save as latest found (so far) for a group
64 . . S FBA(FBGRP)=FBDA1_U_$P(FBY0,U,2)
65 . ;
66 . ; build FBZFE array for selected authorizations
67 . S FBI=0 ; init number of array elements
68 . S FBGRP="" F S FBGRP=$O(FBA(FBGRP)) Q:FBGRP="" D
69 . . S FBDA1=$P(FBA(FBGRP),U)
70 . . D AUTH
71 ;
72QUIT ;
73 Q
74 ;
75AUTH ; Add node (HL7 ZFE seg.) to FBZFE array for a specified authorization
76 ; Input:
77 ; DFN - veteran ien (file #2 and #161)
78 ; FBDA1 - authorization ien (authorization multiple of #161)
79 ; FBI - previous set ID number used for array or 0 when none
80 ; FBSTR - comma delimited string of requested fields
81 ; Output:
82 ; FBI - set ID (modified)
83 ; FBZFE(FBI) - output array element for one set ID
84 ; ZFE ^ set ID ^ treat. type ^ FEE program ^ From ^ To
85 ;
86 N FBY0,X
87 ;
88 S FBY0=$G(^FBAAA(DFN,1,FBDA1,0))
89 Q:FBY0="" ; nothing to process
90 ;
91 S FBI=FBI+1
92 ;
93 S FBZFE(FBI)="ZFE"
94 S $P(FBZFE(FBI),HLFS,6)=""
95 I FBSTR[",1," S $P(FBZFE(FBI),HLFS,2)=FBI ; sequential number
96 I FBSTR[",2," S X=$$EXTERNAL^DILFD(161.01,.095,"",$P(FBY0,U,13)),$P(FBZFE(FBI),HLFS,3)=$S(X]"":X,1:HLQ)_$E(HLECH)_$E(HLECH)_"VA0033" ; Treatment Type
97 I FBSTR[",3," S X=$S($P(FBY0,U,3):$P($G(^FBAA(161.8,$P(FBY0,U,3),0)),U),1:""),$P(FBZFE(FBI),HLFS,4)=$S(X]"":X,1:HLQ)_$E(HLECH)_$E(HLECH)_"VA0034" ; FEE Program
98 I FBSTR[",4," S $P(FBZFE(FBI),HLFS,5)=$S($P(FBY0,U)]"":$$HLDATE^HLFNC($P(FBY0,U)),1:HLQ) ; From Date
99 I FBSTR[",5," S $P(FBZFE(FBI),HLFS,6)=$S($P(FBY0,U,2)]"":$$HLDATE^HLFNC($P(FBY0,U,2)),1:HLQ) ; To Date
100 Q
Note: See TracBrowser for help on using the repository browser.