Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DVBHQR12

DVBHQR12.m

Go to the documentation of this file.
  1. DVBHQR12 ;ALB/JLU;ROUTINE FOR C&P AND BIRLS ;8/28/91
  1. ;;4.0;HINQ;**32,35,49**;03/25/92
  1. ; PROCESSING THE C&P RECORD AND THEN THE BIRLS RECORD
  1. ;
  1. DEDBL ; The deduction balance segment "E" and "F"
  1. EDEDBL S $P(DVBDBE,U,1)=$E(X,1),$P(DVBDBE,U,2)=$E(X,2,3)
  1. S $P(DVBDBE,U,3)=$E(X,4)
  1. S DVBV1=$E(X,5,10) I DVBV1?5N1A!(DVBV1["{") S DVBV2=6 D SIGN^DVBHUTIL Q:$G(DVBERCS)
  1. S $P(DVBDBE,U,4)=+$E(DVBV1,1,4)_"."_$E(DVBV1,5,6)
  1. S DVBV1=$E(X,11,18) I DVBV1?7N1A!(DVBV1["{") S DVBV2=6 D SIGN^DVBHUTIL Q:$G(DVBERCS)
  1. S DVBP(5)=+$E(DVBV1,1,6)_"."_$E(DVBV1,7,8)_U
  1. S DVBV1=$E(X,19,25) I DVBV1?6N1A!(DVBV1["{") S DVBV2=7 D SIGN^DVBHUTIL Q:$G(DVBERCS)
  1. S $P(DVBDBE,U,6)=+$E(DVBV1,1,5)_"."_$E(DVBV1,6,7),$P(DVBDBE,U,7)=$E(X,26,27)
  1. S $P(DVBDBE,U,8)=$E(X,28,29),$P(DVBDBE,U,9)=$E(X,30)
  1. S L=31 D RON
  1. ;
  1. FDEDBL S $P(DVBDBF,U,1)=$E(X,1),$P(DVBDBF,U,2)=$E(X,2,3)
  1. S $P(DVBDBF,U,3)=$E(X,4)
  1. S DVBV1=$E(X,5,12) I DVBV1?7N1A!(DVBV1["{") S DVBV2=8 D SIGN^DVBHUTIL Q:$G(DVBERCS)
  1. S $P(DVBDBF,U,4)=+$E(DVBV1,1,6)_"."_$E(DVBV1,7,8),$P(DVBDBF,U,5)=$E(X,13,14)
  1. S $P(DVBDBF,U,6)=$E(X,15)
  1. S L=16 D RON
  1. ;
  1. REF ;REFERENCE-NUMBER-DATA.
  1. S $P(DVBREF,U,1)=$E(X,1,9),$P(DVBREF,U,2)=$E(X,10,18)
  1. S $P(DVBREF,U,3)=$E(X,19,27)
  1. S L=28 D RON
  1. ;make a call to INC^DVBHQR13, as the future segments will no longer be
  1. ;included in the VBA response message after DVB*4*49
  1. G INC^DVBHQR13
  1. ;
  1. FUT ;DVB*4*49 - the call to G INC^DVBHQR13 is made in REF, and this code
  1. ;will be skipped
  1. ;FUTURE DATA.
  1. ;A-TYPE-FUTURE-DATA:
  1. S DVBP(3)="A"_"^"_9_"^"
  1. F XX=1:8:65 S DVBP(3)=DVBP(3)_$E(X,XX,XX+7)_"^"
  1. S L=XX+8 D RON
  1. ;E/F-TYPE-FUTURE-DATA:
  1. D FUTE,FUTF
  1. ;
  1. RON 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
  1. I $D(X(2)) S X=X_$E(X(2),1,LY),X(2)=$E(X(2),LY+1,999) Q
  1. Q
  1. ;
  1. RON1 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))
  1. QUIT
  1. ;
  1. FUTE ;future segment type E
  1. S $P(DVBFUE,U)=$E(X,1)
  1. S $P(DVBFUE,U,2)=$E(X,2,9),$P(DVBFUE,U,3)=$E(X,10)
  1. S DVBV1=$E(X,11,16)
  1. I DVBV1?5N1A!(DVBV1["{") S DVBV2=6 D SIGN^DVBHUTIL Q:$G(DVBERCS)
  1. S $P(DVBFUE,U,4)=+$E(DVBV1,1,4)_"."_$E(DVBV1,5,6),$P(DVBFUE,U,5)=$E(X,17)
  1. S $P(DVBFUE,U,6)=$E(X,18,19),$P(DVBFUE,U,7)=$E(X,20,21)
  1. S $P(DVBFUE,U,8)=$E(X,22,23),$P(DVBFUE,U,9)=$E(24,25)
  1. S $P(DVBFUE,U,10)=$E(X,26),$P(DVBFUE,U,11)=$E(X,27)
  1. S $P(DVBFUE,U,12)=$E(X,28,32),$P(DVBFUE,U,13)=$E(X,33,34)
  1. S $P(DVBFUE,U,14)=$E(X,35),$P(DVBFUE,U,15)=$E(X,36)
  1. S $P(DVBFUE,U,16)=$E(X,37),$P(DVBFUE,U,17)=$E(X,38,40)
  1. S L=41 D RON
  1. I $P(DVBFUE,U,3) D LONGE
  1. E S L=31 D RON
  1. Q
  1. ;
  1. LONGE S LP1=18
  1. 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
  1. S L=31 D RON
  1. Q
  1. ;
  1. LONCH I DVBV1?5N1A!(DVBV1["{") S DVBV2=6 D SIGN^DVBHUTIL Q:$G(DVBERCS)
  1. Q
  1. ;
  1. FUTF ;F subsegment of the future segment.
  1. S $P(DVBFUF,U)=$E(X,1)
  1. S $P(DVBFUF,U,2)=$E(X,2,9),$P(DVBFUF,U,3)=$E(X,10)
  1. S $P(DVBFUF,U,4)=$E(X,11,18),$P(DVBFUF,U,5)=$E(X,19,26)
  1. S $P(DVBFUF,U,6)=$E(X,27),$P(DVBFUF,U,7)=$E(X,28)
  1. S $P(DVBFUF,U,8)=$E(X,29),$P(DVBFUF,U,9)=$E(X,30,31)
  1. S $P(DVBFUF,U,10)=$E(X,32),$P(DVBFUF,U,11)=$E(X,33)
  1. S DVBV1=$E(X,34)
  1. I DVBV1?1A!(DVBV1["{") S DVBV2=1 D SIGN^DVBHUTIL Q:$G(DVBERCS)
  1. S $P(DVBFUF,U,12)=DVBV1
  1. S DVBV1=$E(X,35)
  1. I DVBV1?1A!(DVBV1["{") S DVBV2=1 D SIGN^DVBHUTIL Q:$G(DVBERCS)
  1. S $P(DVBFUF,U,13)=DVBV1
  1. S $P(DVBFUF,U,14)=$E(X,36)
  1. S L=37 D RON
  1. S DVBV1=$E(X,1,2)
  1. I DVBV1?1N1A!(DVBV1["{") S DVBV2=2 D SIGN^DVBHUTIL Q:$G(DVBERCS)
  1. S $P(DVBFUF,U,15)=DVBV1
  1. S $P(DVBFUF,U,16)=$E(X,3,5),$P(DVBFUF,U,17)=$E(X,6,9)
  1. S $P(DVBFUF,U,18)=$E(X,10,11),$P(DVBFUF,U,19)=$E(X,12,15)
  1. S $P(DVBFUF,U,20)=$E(X,16,17),$P(DVBFUF,U,21)=$E(X,18,21)
  1. S $P(DVBFUF,U,22)=$E(X,22,23),$P(DVBFUF,U,23)=$E(X,24,27)
  1. S $P(DVBFUF,U,24)=$E(X,28,29),$P(DVBFUF,U,25)=$E(X,30,33)
  1. S $P(DVBFUF,U,26)=$E(X,34,35),$P(DVBFUF,U,27)=$E(X,36,39)
  1. S $P(DVBFUF,U,28)=$E(X,40,41),$P(DVBFUF,U,29)=$E(X,42,44)
  1. S L=45 D RON
  1. Q