source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXBUTL2.m@ 767

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

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1PXBUTL2 ;ISL/DCM - PCE Utilities ;5/21/96 12:15
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**121**;Aug 12, 1996
3 ;
4 ;
5 ;
6 ;
7PRV(CLINIC) ;Get default provider and all providers associated with a clinic
8 ;CLINIC - ifn of clinic in file 44
9 ;External references: ^SC(DA(1),"PR",DA)
10 ; ^VA(200,DA,0)
11 Q:'$G(CLINIC) Q:'$O(^SC(CLINIC,"PR",0))
12 K PXBPMT N IFN,X,NAME
13 S IFN=0 F S IFN=$O(^SC(CLINIC,"PR",IFN)) Q:IFN<1 S X=^(IFN,0) D
14 . S NAME=$P($G(^VA(200,+X,0)),"^") I $L(NAME) S PXBPMT("PRV",NAME,+X)="" S:$P(X,"^",2) PXBPMT("DEF",NAME,+X)=""
15 Q
16POV(CLINIC,CODE) ;Get default diagnosis and all diagnosis associated with clinic
17 ;CLINIC - ifn of clinic in file 44
18 ;CODE - 1 (default) code, 2 diagnosis, 3 both
19 ;External references: ^SC(DA(1),"DX",DA)
20 ; ^ICD9(DA,0)
21 Q:'$G(CLINIC) Q:'$O(^SC(CLINIC,"DX",0))
22 K PXBPMT N IFN,X,NAME
23 S:'$D(CODE) CODE=1
24 S IFN=0 F S IFN=$O(^SC(CLINIC,"DX",IFN)) Q:IFN<1 S X=^(IFN,0) D
25 . ;S NAME=$P($G(^ICD9(+X,0)),"^",1,3)
26 . S NAME=$P($$ICDDX^ICDCODE(+X,IDATE),"^",2,4)
27 . ;jvs 7/22/96 allow selection of v codes
28 . I $L(NAME) S NAME=$S(CODE=2:$S($L($P(NAME,"^",3)):$P(NAME,"^",3),1:$P(NAME,"^")),CODE=3:$P(NAME,"^")_"--"_$P(NAME,"^",3),1:$P(NAME,"^")),PXBPMT("POV",NAME,+X)="" S:$P(X,"^",2) PXBPMT("DEF",NAME,+X)=""
29 Q
30TSTPRV ;Test provider lookup
31 S DIC=44,DIC(0)="AEQLM" D ^DIC Q:Y<1 D PRV(+Y)
32 K DIC
33 Q
34TSTPOV ;Test diagnosis lookup
35 S DIC=44,DIC(0)="AEQLM" D ^DIC Q:Y<1 D POV(+Y,3)
36 K DIC
37 Q
Note: See TracBrowser for help on using the repository browser.