source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGBLRV.m@ 1259

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1DGBLRV ;ALB/BOK - PATIENT ADMISSION FORM/BILL REVIEW ; 18 SEP 86 11:00
2 ;;5.3;Registration;**26,570**;Aug 13, 1993
3 ;
4 D LO^DGUTL K ^UTILITY($J)
5START S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC G QUIT:Y'>0 S DFN=+Y I '$D(^DGPM("ATID1",DFN)) W !,"No admissions on file, will check scheduled admissions",! G SCHAD
6 S DIC("S")="I $P(^(0),U,2)=1" D EN^DGPMUTL K DIC I Y'>0 W !,"Since an admission was not chosen, scheduled admissions for this patient will be checked",! G SCHAD
7 S DGPMDA=+Y G IO
8SCHAD I '$D(^DGS(41.1,"B",DFN)) W !,"No scheduled admissions on file" G QUIT
9 S DGPMDA=0
10IO K DIS(0) S DGPGM="RET^DGBLRV",DGVAR="DFN^DGPMDA" W !!,"This report requires 132 column output",! D ZIS^DGUTQ G QUIT:POP U IO S X=132 X ^%ZOSF("RM")
11RET S:'$D(DGPMDA) DGPMDA=0 K DGADT,DGADX,DGINAD,DGSDT,DGSDX,I S DGINFO=^DPT(DFN,0) D PID^VADPT6
12 I DGPMDA S DGI=$S($D(^DGPM(DGPMDA,0)):^(0),1:"") Q:DGI']"" S Y=$P(DGI,"^",1) D D^DIQ S DGADT=Y,DGADX=$P(DGI,"^",10),DGWD=$P(DGI,"^",6) G INS
13 S DGI=$O(^DGS(41.1,"B",DFN,0)),DGI=^DGS(41.1,DGI,0),DGSDT=$P(DGI,U,2) S Y=DGSDT D D^DIQ S DGSDT=Y,DGSDX=$P(DGI,U,4),DGWD=$P(DGI,U,8)
14 ;
15INS ; -- new insurance logic, modified for IBBAPI insurance call, DG*570
16 N DGIBINS,DGIBDT,DGDATA,DGIB,DGX
17 S DGIBDT=$S($D(DGPMDA):+$G(^DGPM(DGPMDA,0)),$G(DGSDT):DGSDT,1:DT)
18 S DGIBDT=$P(DGIBDT,".")
19 S DGIB=$$INSUR^IBBAPI(DFN,DGIBDT,"R",.DGDATA,"*")
20 S DGX="DGDATA(""IBBAPI"",""INSUR"")" M DGIBINS=@DGX
21 S P=1,I=0
22 I DGIB F S I=$O(DGIBINS(I)) Q:'I D
23 . I DGIBINS(I,11)>DT!(DGIBINS(I,11)="") D
24 . . K DGINAD D:DGI ADDR
25 . . S I(P)=+DGIBINS(I,1)_U_DGIBINS(I,14)_U
26 . . N DGGRP
27 . . S DGGRP=DGIBINS(I,18) ; Group Policy Number
28 . . S I(P)=I(P)_$G(DGGRP)_U
29 . . S I(P)=I(P)_$P(DGIBINS(I,8),U,2)_U_$S($D(DGINAD):DGINAD,1:"NO ADDRESS ON FILE")
30 . . S P=P+1
31 ;
32PRT K DIC S DIC(0)="M",X="DGBILLREVIEW",DIC="^DIC(47," D ^DIC G QUIT:Y'>0 S DGY=+Y I '$D(DIS(0)) I $$FIRST^DGUTL G Q
33 S P=0 F DGLN=0:0 S DGLN=$O(^DIC(47,+DGY,1,DGLN)) Q:'DGLN S J=^(DGLN,0),X1="" W ! F K=1:1 W $E($P(J,"{}",K),$S(K=1:1,X1']"":1,1:$L(X)+1),999) S X1=$P(J,"{",K+1),P=$S(DGLN<9:1,DGLN<14:2,1:3) Q:X1']"" D CKLN
34Q W ! Q:$D(DIS(0)) I '$D(DGOPT) D CLOSE^DGUTQ
35QUIT D ENDREP^DGUTL I '$D(DGPMA) K DFN,DGPMDA
36 K DGADT,DGADX,DGI,DGIMULT,DGINAD,DGINFO,DGINS,DGLN,DGPGM,DGSDT,DGSDX,DGVAR,DGWD,DGY,DIC,I,J,K,P,X,X1,L,VA,Y,POP Q
37 Q
38 ;
39CKLN S L=$S(DGLN>9&(DGLN<14):(DGLN-5),DGLN>14&(DGLN<19):(DGLN-10),1:DGLN)_K D @L Q
40ADDR ;
41 S DGINAD=$S(DGIBINS(I,2)]"":DGIBINS(I,2)_", ",1:"")_$S(DGIBINS(I,2)]"":DGIBINS(I,3)_", ",1:"")_$S(DGIBINS(I,4)]"":$P(DGIBINS(I,4),U,2)_", ",1:"")_$S(DGIBINS(I,5)]"":DGIBINS(I,5)_", ",1:"")
42 Q
4321 S Y=DT D DT^DIQ Q
4431 W $P(DGINFO,U,1) Q
4532 W VA("PID") Q
4651 W $S($D(DGIBINS(P)):$P(DGIBINS(P,1),U,2),1:"") Q
4761 W $S($D(I(P)):$P(I(P),U,5),1:"") Q
4871 W $S($D(DGIBINS(P)):DGIBINS(P,6),1:"") Q
4972 W $S($D(I(P)):$P(I(P),U,2),1:"") Q
5073 W $S($D(I(P)):$P(I(P),U,3),1:"") Q
5181 W " " Q ; Pre-certification phone# not currently available in API
5282 W " " Q ; Billing phone# not currently available in API
53201 W $S($D(DGADX):DGADX,$D(DGSDX):DGSDX,1:"") Q
54202 S X=$S(DGWD:DGWD,1:"-") W $S($D(^DIC(42,X,0)):$P(^(0),U,1),1:"") Q
55211 W $S($D(DGSDT):DGSDT,1:"") Q
56212 W $S($D(DGADT):DGADT,1:"") Q
57 ;
58EN1 S DIC="^DGPM(",BY="@.01",L=0,FLDS="[DGPMBLRV]",DHD="@"
59 S DIS(0)="S DFN=$P(^DGPM(D0,0),U,3) I $P(^(0),""^"",2)=1,$D(^DPT(DFN,""VET"")),($P(^(""VET""),""^"",1)=""Y""),$$INSUR^IBBAPI(DFN,"""",""A"")"
60 D EN1^DIP,QUIT K BY,DHD,DIC,DIS,FLDS,I Q
61 ;
62CK ;check logic to see if 3rd party review is asked
63 ;***if this logic is altered, also change line EN1+1 in DIS(0)***
64 I $S('$$INSUR^IBBAPI(DFN,"","A"):1,'$D(^DPT(DFN,"VET")):1,^("VET")'="Y":1,1:0) Q
65ASK ;print TPR?
66 W !,"PRINT THIRD PARTY REVIEW" S %=$S($D(DGDEF):DGDEF,1:2) D YN^DICN
67 I %=2!(%<0) Q
68 I '% W !!,"CHOOSE FROM",!?4,"YES - If you wish to print Third Party Review Sheet",!?4,"NO - If you don't want to print Third Party Review Sheet",! G ASK
69 Q:$D(DGNOQ) ;quit if from 10/10 w/out registration
70 K DGPTPR S DGPGM="RET^DGBLRV",DGVAR="DFN"_$S($D(DGPMDA):"^DGPMDA",1:"") K DIS D ZIS^DGUTQ I 'POP U IO D RET^DGBLRV
71 K DGPGM,DGVAR Q
Note: See TracBrowser for help on using the repository browser.