source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRBEBA31.m@ 1261

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1LRBEBA31 ;DALOI/JAH/FHS - ORDERING AND RESULTING OUTPATIENT ;8/10/04
2 ;;5.2;LAB SERVICE;**291**;Sep 27, 1994
3 ;
4DADD(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 ;
22SBA(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
Note: See TracBrowser for help on using the repository browser.