| 1 | IB20PT8A ;ALB/CPM - EXPORT ROUTINE 'DG3PR2' ; 24-FEB-94
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
|
|---|
| 3 | ;
|
|---|
| 4 | DG3PR2 ;ALB/MIR - CONTINUATION OF THE THIRD PARTY REIMBURSEMENT ; NOV 21 90@8
|
|---|
| 5 | ;;5.3;Registration;**26**;Aug 13, 1993
|
|---|
| 6 | S DGINS=0 W !!,"INSURANCE TYPE",?24,"INSURANCE #",?45,"GROUP #",?63,"EXPIRES HOLDER",!,"--------- ----",?24,"--------- -",?45,"----- -",?63,"------- ------"
|
|---|
| 7 | D ALL^IBCNS1(DFN,"DGIBINS") F I=0:0 S I=$O(DGIBINS(I)) Q:'I S J=DGIBINS(I,0) S X=$G(^DIC(36,+J,0)) W !,$S($P(X,"^",2)="N":"*",1:""),$E($P(X,"^",1),1,22),?24,$P(J,"^",2),?45,$P(J,"^",3) S DGINS=$S($P(X,"^",2)="N":1,1:0) D INS2
|
|---|
| 8 | I DGINS W !?22,"* - Insurer may not reimburse!"
|
|---|
| 9 | K DGINS,DGIBINS
|
|---|
| 10 | S Y=+DGAD X ^DD("DD") W !!,"Admitted: ",Y,?40,"Discharged: " S Y=+DGDC I Y X ^DD("DD") W Y
|
|---|
| 11 | I $P(DGAD,"^",18)=9 W !,"Transferred in From ",$S($D(^DIC(4,+$P(DGAD,"^",5),0)):$P(^(0),"^",1),1:"")
|
|---|
| 12 | S DGPTF=$P(DGAD,"^",16) I 'DGPTF!('$D(^DGPT(+DGPTF,0))) W !,"No PTF Record Exists" Q
|
|---|
| 13 | I '$D(^DGP(45.84,DGPTF)) W !,"PTF Record not closed",!
|
|---|
| 14 | K ^UTILITY("DG") F I=0:0 S I=$O(^DGPT(DGPTF,"M",I)) Q:'I S J=^(I,0) S:$P(J,"^",2) ^UTILITY("DG",$J,"M",+$P(J,"^",10))=J
|
|---|
| 15 | F I=0:0 S I=$O(^DGPT(DGPTF,"S",I)) Q:'I D HEAD:$Y>(IOSL-5) Q:'DGFL S J=^DGPT(DGPTF,"S",I,0),^UTILITY("DG",$J,"S",+J)=J
|
|---|
| 16 | Q:'DGFL I $O(^UTILITY("DG",$J,"M",0)) W !!,"DATE",?22,"LOS BEDSECTION",?39,"LOS",?45,"DIAGNOSES",!,"----",?22,"---------------",?39,"---- ---------"
|
|---|
| 17 | S DGPR=DGAD F I=0:0 S I=$O(^UTILITY("DG",$J,"M",I)) Q:'I S J=^(I) D HEAD:$Y>(IOSL-5) Q:'DGFL S Y=I X ^DD("DD") D LOL W !,Y,?22,$E($S($D(^DIC(42.4,+$P(J,"^",2),0)):$P(^(0),"^",1),1:""),1,16),?39,$J(DGLOL,4) D DIAG S DGPR=I
|
|---|
| 18 | Q:'DGFL S DGPMIFN=DGCA D ^DGPMLOS W !?39,"---- ----------",!?26,"TOTAL LOS:",?39,$J(+$P(X,"^",5),4),?45,$S($D(^ICD9(+$S($D(^DGPT(DGPTF,70)):$P(^(70),"^",10),1:""),0)):"DXLS: "_$P(^(0),"^",1)_" ("_$P(^(0),"^",3)_")",1:"")
|
|---|
| 19 | Q:'$O(^UTILITY("DG",$J,"S",0)) D HEAD:$Y>(IOSL-10) Q:'DGFL W !!,"SURGERY DATE",?22,"SPECIALTY",?45,"OP CODES",!,"------------",?22,"----------",?44,"--------"
|
|---|
| 20 | F I=0:0 S I=$O(^UTILITY("DG",$J,"S",I)) Q:'I S J=^(I),Y=I X ^DD("DD") W !,Y,?22,$E($S($D(^DIC(45.3,+$P(J,"^",3),0)):$P(^(0),"^",2),1:""),1,16) D OP
|
|---|
| 21 | Q
|
|---|
| 22 | DIAG S M=0 F K=5:1:15 I K'=10 S L=$P(J,"^",K) I L W:M ! W ?45,$S($D(^ICD9(+L,0)):$P(^(0),"^",1)_" ("_$P(^(0),"^",3)_")",1:"") S M=1
|
|---|
| 23 | Q
|
|---|
| 24 | OP S M=0 F K=8:1:12 S L=$P(J,"^",K) I L W:M ! W ?45,$S($D(^ICD0(+L,0)):$P(^(0),"^",1)_" ("_$P(^(0),"^",4)_")",1:"") S M=1
|
|---|
| 25 | Q
|
|---|
| 26 | LOL S X1=I,X2=DGPR D DTC S DGLOL=X
|
|---|
| 27 | F K=DGPR+.0000005:0 S K=$O(^DGPM("APCA",DFN,DGCA,K)) Q:'K!(K>I) S C=$O(^(+K,0)) I $D(^DGPM(+C,0)),"^2^3^13^43^44^45^"[("^"_$P(^(0),"^",18)_"^") S X1=$O(^DGPM("APCA",DFN,DGCA,K)),X1=$S('X1:I,X1>I:I,1:X1),X2=K D DTC S DGLOL=DGLOL-X
|
|---|
| 28 | Q
|
|---|
| 29 | HEAD N I,J,K,L,M,Y I $E(IOST,1)="C" S DIR(0)="E" D ^DIR S DGFL=Y I 'DGFL Q
|
|---|
| 30 | W @IOF,!,"THIRD PARTY REIMBURSEMENT",?49,"PRINTED: ",DGNOW
|
|---|
| 31 | W !,"("_$P(^DPT(DFN,0),"^",1)_")",!
|
|---|
| 32 | Q
|
|---|
| 33 | INS2 ;insurance data continued
|
|---|
| 34 | I $P(X,"^",2)="N" S DGINS=1
|
|---|
| 35 | S X=$P(J,"^",4) W:X]"" ?63,$E(X,4,5),"/",$E(X,6,7),"/",$E(X,2,3) S X=$P(J,"^",6) W ?73,$S(X="v":"VETERAN",X="s":"SPOUSE",X="o":"OTHER",1:"UNKNOWN")
|
|---|
| 36 | Q
|
|---|
| 37 | DTC N I,J,K,L,M,Y D ^%DTC Q
|
|---|
