| 1 | LRBEBA31 ;DALOI/JAH/FHS - ORDERING AND RESULTING OUTPATIENT ;8/10/04
|
|---|
| 2 | ;;5.2;LAB SERVICE;**291**;Sep 27, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | DADD(LRODT,LRSN,LRBETN,LRXDA,LRTS,LRBERF) ; Take care of ADDs to accession
|
|---|
| 5 | N LRBEALO,LRBEAALO,LRBEFN,LRBEX,LRBEVAL,LRBEXD,LRBEQT,LRBESPEC,LRBESAMP
|
|---|
| 6 | Q:'$$CIDC^IBBAPI(DFN)
|
|---|
| 7 | S LRBERF=$G(LRBERF)
|
|---|
| 8 | S LRBEVAL=$D(^XUSEC("PROVIDER",DUZ))
|
|---|
| 9 | S LRBEFN="O",LRBEDFN=DFN
|
|---|
| 10 | S X=^LRO(69,LRODT,1,LRSN,0),LRBESAMP=$P(X,"^",3) K X
|
|---|
| 11 | S LRBESPEC=$O(^LRO(69,LRODT,1,LRSN,4,0))
|
|---|
| 12 | S LRBESPEC=$S(LRBESPEC>0:$P(^LRO(69,LRODT,1,LRSN,4,LRBESPEC,0),"^",1),1:"")
|
|---|
| 13 | I LRBERF=1 D
|
|---|
| 14 | . D QRYADD^LRBEBA3(LRODT,LRSN,LRBETN,LRBEDFN,LRBESAMP,LRBESPEC,LRTS,.LRBEX)
|
|---|
| 15 | . D SACC^LRBEBA2(LRODT,LRSN,LRXDA,LRBESAMP,LRBESPEC,LRTS,.LRBEX)
|
|---|
| 16 | I LRBEVAL,LRBERF=0 D
|
|---|
| 17 | . D ELIG^LRBEBA3(LRBEDFN)
|
|---|
| 18 | . S LRBEQT=$$QUES^LRBEBA(LRBEDFN,LRBESAMP,LRBESPEC,LRTS,LRODT,.LRBEX)
|
|---|
| 19 | . D:'LRBEQT SACC^LRBEBA2(LRODT,LRSN,LRXDA,LRBESAMP,LRBESPEC,LRTS,.LRBEX)
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | SBA(LRDFN,LRBEX,LRBEQT,LROT) ; billing questions
|
|---|
| 23 | N LRBECNT,LRBEST,LRBEDFN,LRBESMP,LRBESPC,LRBEY,LRBETN,LRBEQT
|
|---|
| 24 | N LRBEOT,LRBETS,LRBEMSG,LRBEPTDT
|
|---|
| 25 | I '$D(DFN) S LRBEDFN=$$GET1^DIQ(63,LRDFN,.03,"I")
|
|---|
| 26 | S:$D(DFN) LRBEDFN=DFN
|
|---|
| 27 | D:$G(LRBEAT)=1 ELIG^LRBEBA3(LRBEDFN)
|
|---|
| 28 | S LRBEST=1,LRBEQT=0
|
|---|
| 29 | S LRBESMP="" F S LRBESMP=$O(LROT(LRBESMP)) Q:LRBESMP=""!(LRBEQT) D
|
|---|
| 30 | .S LRBESPC="" F S LRBESPC=$O(LROT(LRBESMP,LRBESPC)) Q:LRBESPC="" D
|
|---|
| 31 | ..S LRBEY="" F S LRBEY=$O(LROT(LRBESMP,LRBESPC,LRBEY)) Q:LRBEY="" D
|
|---|
| 32 | ...S LRBEOT(LRBEY,LRBESMP,LRBESPC)=""
|
|---|
| 33 | S LRBEY="" F S LRBEY=$O(LRBEOT(LRBEY)) Q:LRBEY="" D
|
|---|
| 34 | .S LRBESMP="" F S LRBESMP=$O(LRBEOT(LRBEY,LRBESMP)) Q:LRBESMP=""!(LRBEQT) D
|
|---|
| 35 | ..S LRBESPC="" F S LRBESPC=$O(LRBEOT(LRBEY,LRBESMP,LRBESPC)) Q:LRBESPC="" D
|
|---|
| 36 | ...S LRBEPTDT=$G(LROT(LRBESMP,LRBESPC,LRBEY)),LRBETS=$P(LRBEPTDT,U,1)
|
|---|
| 37 | ...S LRBETN=$$GET1^DIQ(60,LRBETS_",",.01)
|
|---|
| 38 | ...S LRBEMSG="Enter information for "_LRBETN D EN^DDIOL(LRBEMSG,"","!")
|
|---|
| 39 | ...S:$G(LRBEAT)'=1 LRBEALO=1
|
|---|
| 40 | ...S LRBEQT=$$QUES^LRBEBA(LRBEDFN,LRBESMP,LRBESPC,LRBETS,LRODT,.LRBEX)
|
|---|
| 41 | ...S:LRBEQT LRBEST=0 Q:LRBEQT
|
|---|
| 42 | ...D EN^DDIOL("","","!")
|
|---|
| 43 | Q LRBEST
|
|---|
