| 1 | IB20PT88 ;ALB/CPM - EXPORT ROUTINE 'DG3PR0' ; 24-FEB-94
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
|
|---|
| 3 | ;
|
|---|
| 4 | DG3PR0 ;ALB/JDS - 10-10I ;01 JAN 1987
|
|---|
| 5 | ;;5.3;Registration;**26**;Aug 13, 1993
|
|---|
| 6 | START K ^UTILITY($J) S (N(1),N(0),DG(1),DG(0))="" D ALL^IBCNS1(DFN,"DGIBINS") F I=0:0 S I=$O(DGIBINS(I)) Q:'I S L=DGIBINS(I,0),M=$P(L,U,6),M=$S(M']"":0,1:M),^UTILITY($J,M,I)=L
|
|---|
| 7 | F I="v",0,"s","o" I $D(^UTILITY($J,I)) S DG(0)=^($O(^(I,0))),N(0)=I Q
|
|---|
| 8 | F I="v",0,"s","o" I $D(^UTILITY($J,I)) S L=$S(N(0)=I:$O(^($O(^(I,0)))),1:$O(^(I,0))) I L>0 S DG(1)=^UTILITY($J,I,L),N(1)=I Q
|
|---|
| 9 | ;K ^UTILITY($J)
|
|---|
| 10 | PRINT ;
|
|---|
| 11 | G:$$FIRST^DGUTL Q
|
|---|
| 12 | I '$D(DGNOW) N DGNOW D NOW^%DTC,YX^%DTC S DGNOW=Y
|
|---|
| 13 | W "Printed: ",DGNOW
|
|---|
| 14 | S DIC(0)="LM",X="DG1010I",DIC="^DIC(47," D ^DIC G Q:Y'>0 S DGY=+Y
|
|---|
| 15 | F I=0,.21,.22,.25,.311 S D(I)=$S($D(^DPT(DFN,I)):^(I),1:"")
|
|---|
| 16 | S Y=$P(D(.22),U,5) D ZIPOUT^VAFADDR S X=$P(D(.311),U,6,7)_U_Y D AD2 S D(.311)=$P(D(.311),U,1)_U_$P(D(.311),U,9)_U_$P(D(.311),U,3)_" "_$P(D(.311),U,4)_" "_$P(D(.311),U,5)_U_X
|
|---|
| 17 | S Y=$P(D(.22),U,6) D ZIPOUT^VAFADDR S X=$P(D(.25),U,5,6)_U_Y D AD2 S D(.25)=$P(D(.25),U,1)_U_$P(D(.25),U,8)_U_$P(D(.25),U,2)_" "_$P(D(.25),U,3)_" "_$P(D(.25),U,4)_U_X
|
|---|
| 18 | F I=0,1 D SET
|
|---|
| 19 | S (L,DGL)=0 F I=0:0 S I=$O(^DIC(47,+DGY,1,I)) Q:'I!(DGL=I) S J=^(I,0),X="" W ! F K=1:1 W $E($P(J,"{}",K),$S(K=1:1,X']"":1,1:$L(X)-1),999) S X=$P(J,"{",K+1) Q:X']"" S L=L+1 D SE W:X']"" " "
|
|---|
| 20 | Q D ENDREP^DGUTL K A,B,D,DG,DGL,DGY,DIC,E,I,J,K,L,M,N,X,X1,X2,Y,DGIBINS,^UTILITY($J)
|
|---|
| 21 | Q
|
|---|
| 22 | SET S A=DG(I),A=$S($D(^DIC(36,+A,0)):^(0),1:""),B=$G(^DIC(36,+DG(I),.11)),Y=$P(B,U,6) D ZIPOUT^VAFADDR S X=$P(B,U,4,5)_U_Y D AD2
|
|---|
| 23 | S X(I)=$P(A,U,1)_U_$P($G(^DIC(36,+DG(I),.13)),U,1)_U_$P(B,U,1)_U_X_U_$P(DG(I),U,2)_U_$P(DG(I),U,3)_U,Y=$P(DG(I),U,8) X ^DD("DD") S X(I)=X(I)_Y_U,Y=$P(DG(I),U,7) X ^DD("DD") S X(I)=X(I)_Y
|
|---|
| 24 | S N=$S(N(I)="s":$P(DG(I),U,17)_U_"SPOUSE",(N(I)=0!(N(I)="v")):$P(D(0),U,1)_U_"SAME",1:$P(DG(I),U,17)_U)
|
|---|
| 25 | S E=$S(N(I)=0!(N(I)="v"):D(.311),N(I)="s":D(.25),1:"^^^^")
|
|---|
| 26 | S X=$P(DG(I),U,12,14) D AD2 S X1(I)=N_U_E,X2(I)=$P(DG(I),U,9,11)_U_X
|
|---|
| 27 | Q
|
|---|
| 28 | AD2 S X=$P(X,U,1)_$S($P(X,U,1)]"":", ",1:"")_$S($D(^DIC(5,+$P(X,U,2),0)):$P(^(0),U,1),1:"")_" "_$P(X,U,3) Q
|
|---|
| 29 | SE I L>2&(L<11) S X=$P(X(L\21),U,L-$S(L>20:20,1:2)) W X Q
|
|---|
| 30 | I L>10&(L<17) S X=$P(X1(L\21),U,L-10) W X Q
|
|---|
| 31 | I L>16&(L<21) S X=$P(X2(L\21),U,L-16) W X Q
|
|---|
| 32 | I L>20&(L<29) S X=$P(X(L\21),U,L-20) W X Q
|
|---|
| 33 | I L>28&(L<35) S X=$P(X1(L\21),U,L-28) W X Q
|
|---|
| 34 | I L>34 S X=$P(X2(L\21),U,L-34) W X Q
|
|---|
| 35 | S X=$P(D(0),U,$S(L=1:1,1:9)) W X Q
|
|---|
| 36 | Q
|
|---|
