source: FOIAVistA/tag/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHQR12.m@ 1424

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1DVBHQR12 ;ALB/JLU;ROUTINE FOR C&P AND BIRLS ;8/28/91
2 ;;4.0;HINQ;**32,35,49**;03/25/92
3 ; PROCESSING THE C&P RECORD AND THEN THE BIRLS RECORD
4 ;
5DEDBL ; The deduction balance segment "E" and "F"
6EDEDBL S $P(DVBDBE,U,1)=$E(X,1),$P(DVBDBE,U,2)=$E(X,2,3)
7 S $P(DVBDBE,U,3)=$E(X,4)
8 S DVBV1=$E(X,5,10) I DVBV1?5N1A!(DVBV1["{") S DVBV2=6 D SIGN^DVBHUTIL Q:$G(DVBERCS)
9 S $P(DVBDBE,U,4)=+$E(DVBV1,1,4)_"."_$E(DVBV1,5,6)
10 S DVBV1=$E(X,11,18) I DVBV1?7N1A!(DVBV1["{") S DVBV2=6 D SIGN^DVBHUTIL Q:$G(DVBERCS)
11 S DVBP(5)=+$E(DVBV1,1,6)_"."_$E(DVBV1,7,8)_U
12 S DVBV1=$E(X,19,25) I DVBV1?6N1A!(DVBV1["{") S DVBV2=7 D SIGN^DVBHUTIL Q:$G(DVBERCS)
13 S $P(DVBDBE,U,6)=+$E(DVBV1,1,5)_"."_$E(DVBV1,6,7),$P(DVBDBE,U,7)=$E(X,26,27)
14 S $P(DVBDBE,U,8)=$E(X,28,29),$P(DVBDBE,U,9)=$E(X,30)
15 S L=31 D RON
16 ;
17FDEDBL S $P(DVBDBF,U,1)=$E(X,1),$P(DVBDBF,U,2)=$E(X,2,3)
18 S $P(DVBDBF,U,3)=$E(X,4)
19 S DVBV1=$E(X,5,12) I DVBV1?7N1A!(DVBV1["{") S DVBV2=8 D SIGN^DVBHUTIL Q:$G(DVBERCS)
20 S $P(DVBDBF,U,4)=+$E(DVBV1,1,6)_"."_$E(DVBV1,7,8),$P(DVBDBF,U,5)=$E(X,13,14)
21 S $P(DVBDBF,U,6)=$E(X,15)
22 S L=16 D RON
23 ;
24REF ;REFERENCE-NUMBER-DATA.
25 S $P(DVBREF,U,1)=$E(X,1,9),$P(DVBREF,U,2)=$E(X,10,18)
26 S $P(DVBREF,U,3)=$E(X,19,27)
27 S L=28 D RON
28 ;make a call to INC^DVBHQR13, as the future segments will no longer be
29 ;included in the VBA response message after DVB*4*49
30 G INC^DVBHQR13
31 ;
32FUT ;DVB*4*49 - the call to G INC^DVBHQR13 is made in REF, and this code
33 ;will be skipped
34 ;FUTURE DATA.
35 ;A-TYPE-FUTURE-DATA:
36 S DVBP(3)="A"_"^"_9_"^"
37 F XX=1:8:65 S DVBP(3)=DVBP(3)_$E(X,XX,XX+7)_"^"
38 S L=XX+8 D RON
39 ;E/F-TYPE-FUTURE-DATA:
40 D FUTE,FUTF
41 ;
42RON S X=$E(X,L,999),LX=$L(X),LY=254-LX I $D(X(2)),(LX+$L(X(2)))<256 S X=X_X(2) K X(2) D RON1 Q
43 I $D(X(2)) S X=X_$E(X(2),1,LY),X(2)=$E(X(2),LY+1,999) Q
44 Q
45 ;
46RON1 F Z1=3:1:99 I $D(X(Z1)),'$D(X(Z1-1)) S X(Z1-1)=X(Z1) K X(Z1) Q:'$O(X(Z1))
47 QUIT
48 ;
49FUTE ;future segment type E
50 S $P(DVBFUE,U)=$E(X,1)
51 S $P(DVBFUE,U,2)=$E(X,2,9),$P(DVBFUE,U,3)=$E(X,10)
52 S DVBV1=$E(X,11,16)
53 I DVBV1?5N1A!(DVBV1["{") S DVBV2=6 D SIGN^DVBHUTIL Q:$G(DVBERCS)
54 S $P(DVBFUE,U,4)=+$E(DVBV1,1,4)_"."_$E(DVBV1,5,6),$P(DVBFUE,U,5)=$E(X,17)
55 S $P(DVBFUE,U,6)=$E(X,18,19),$P(DVBFUE,U,7)=$E(X,20,21)
56 S $P(DVBFUE,U,8)=$E(X,22,23),$P(DVBFUE,U,9)=$E(24,25)
57 S $P(DVBFUE,U,10)=$E(X,26),$P(DVBFUE,U,11)=$E(X,27)
58 S $P(DVBFUE,U,12)=$E(X,28,32),$P(DVBFUE,U,13)=$E(X,33,34)
59 S $P(DVBFUE,U,14)=$E(X,35),$P(DVBFUE,U,15)=$E(X,36)
60 S $P(DVBFUE,U,16)=$E(X,37),$P(DVBFUE,U,17)=$E(X,38,40)
61 S L=41 D RON
62 I $P(DVBFUE,U,3) D LONGE
63 E S L=31 D RON
64 Q
65 ;
66LONGE S LP1=18
67 F LP=1:6:25 S DVBV1=$E(X,LP,LP+5) D LONCH S $P(DVBFUE,U,LP1)=+$E(DVBV1,1,4)_"."_$E(DVBV1,5,6),LP1=LP1+1
68 S L=31 D RON
69 Q
70 ;
71LONCH I DVBV1?5N1A!(DVBV1["{") S DVBV2=6 D SIGN^DVBHUTIL Q:$G(DVBERCS)
72 Q
73 ;
74FUTF ;F subsegment of the future segment.
75 S $P(DVBFUF,U)=$E(X,1)
76 S $P(DVBFUF,U,2)=$E(X,2,9),$P(DVBFUF,U,3)=$E(X,10)
77 S $P(DVBFUF,U,4)=$E(X,11,18),$P(DVBFUF,U,5)=$E(X,19,26)
78 S $P(DVBFUF,U,6)=$E(X,27),$P(DVBFUF,U,7)=$E(X,28)
79 S $P(DVBFUF,U,8)=$E(X,29),$P(DVBFUF,U,9)=$E(X,30,31)
80 S $P(DVBFUF,U,10)=$E(X,32),$P(DVBFUF,U,11)=$E(X,33)
81 S DVBV1=$E(X,34)
82 I DVBV1?1A!(DVBV1["{") S DVBV2=1 D SIGN^DVBHUTIL Q:$G(DVBERCS)
83 S $P(DVBFUF,U,12)=DVBV1
84 S DVBV1=$E(X,35)
85 I DVBV1?1A!(DVBV1["{") S DVBV2=1 D SIGN^DVBHUTIL Q:$G(DVBERCS)
86 S $P(DVBFUF,U,13)=DVBV1
87 S $P(DVBFUF,U,14)=$E(X,36)
88 S L=37 D RON
89 S DVBV1=$E(X,1,2)
90 I DVBV1?1N1A!(DVBV1["{") S DVBV2=2 D SIGN^DVBHUTIL Q:$G(DVBERCS)
91 S $P(DVBFUF,U,15)=DVBV1
92 S $P(DVBFUF,U,16)=$E(X,3,5),$P(DVBFUF,U,17)=$E(X,6,9)
93 S $P(DVBFUF,U,18)=$E(X,10,11),$P(DVBFUF,U,19)=$E(X,12,15)
94 S $P(DVBFUF,U,20)=$E(X,16,17),$P(DVBFUF,U,21)=$E(X,18,21)
95 S $P(DVBFUF,U,22)=$E(X,22,23),$P(DVBFUF,U,23)=$E(X,24,27)
96 S $P(DVBFUF,U,24)=$E(X,28,29),$P(DVBFUF,U,25)=$E(X,30,33)
97 S $P(DVBFUF,U,26)=$E(X,34,35),$P(DVBFUF,U,27)=$E(X,36,39)
98 S $P(DVBFUF,U,28)=$E(X,40,41),$P(DVBFUF,U,29)=$E(X,42,44)
99 S L=45 D RON
100 Q
Note: See TracBrowser for help on using the repository browser.