| [641] | 1 | XBFUNC2 ; IHS/ADC/GTH - FUNCTION LIBRARY : PCC RELATED FUNCTIONS ; [ 02/07/97 3:02 PM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | PCCPPINT(XBVISIT) ;PEP - Return primary provider ien in VA(200
|
|---|
| 6 | NEW X,Y,Z,XBX,DIC,DR,DA,DIQ,XBY
|
|---|
| 7 | S XBX=0
|
|---|
| 8 | F S XBX=$O(^AUPNVPRV("AD",XBVISIT,XBX)) Q:XBX'=+XBX I $P(^AUPNVPRV(XBX,0),U,4)="P" S XBY=+^AUPNVPRV(XBX,0) Q
|
|---|
| 9 | I '$G(XBY) Q ""
|
|---|
| 10 | Q XBY
|
|---|
| 11 | ;
|
|---|
| 12 | PCCPPN(XBVISIT) ;PEP - Return a visit's primary provider (NAME)
|
|---|
| 13 | NEW X,Y,Z,XBX,DIC,DR,DA,DIQ,XBY
|
|---|
| 14 | S XBX=0
|
|---|
| 15 | F S XBX=$O(^AUPNVPRV("AD",XBVISIT,XBX)) Q:XBX'=+XBX I $P(^AUPNVPRV(XBX,0),U,4)="P" S XBY=XBX Q
|
|---|
| 16 | I '$G(XBY) Q "NONE ENTERED"
|
|---|
| 17 | S XBX=$$VAL^XBDIQ1(9000010.06,XBY,.01)
|
|---|
| 18 | Q:XBX="" "NONE ENTERED"
|
|---|
| 19 | Q XBX
|
|---|
| 20 | ;
|
|---|
| 21 | PCCPPI(XBVISIT) ;PEP - Return a visit's primary provider (INITIALS)
|
|---|
| 22 | NEW X,Y,Z,XBX,DIC,DR,DA,DIQ,XBY
|
|---|
| 23 | S XBX=0
|
|---|
| 24 | F S XBX=$O(^AUPNVPRV("AD",XBVISIT,XBX)) Q:XBX'=+XBX I $P(^AUPNVPRV(XBX,0),U,4)="P" S XBY=+^AUPNVPRV(XBX,0) Q
|
|---|
| 25 | I '$G(XBY) Q "???"
|
|---|
| 26 | S XBX=$$VAL^XBDIQ1($S($P($G(^AUTTSITE(1,0)),U,22):200,1:6),XBY,1)
|
|---|
| 27 | Q:XBX="" "???"
|
|---|
| 28 | Q XBX
|
|---|
| 29 | ;
|
|---|
| 30 | PCCPPCLS(XBVISIT,FORM) ;PEP - Return a visit's primary provider class (CODE)
|
|---|
| 31 | NEW X,Y,Z,XBX,DIC,DR,DA,DIQ,XBY,XBCODE
|
|---|
| 32 | S XBX=0
|
|---|
| 33 | F S XBX=$O(^AUPNVPRV("AD",XBVISIT,XBX)) Q:XBX'=+XBX I $P(^AUPNVPRV(XBX,0),U,4)="P" S XBY=+^AUPNVPRV(XBX,0) Q
|
|---|
| 34 | I '$G(XBY) Q "???"
|
|---|
| 35 | S:$G(FORM)="I" DIQ(0)="I"
|
|---|
| 36 | S DA=XBY,DIC=$S($P($G(^AUTTSITE(1,0)),U,22):200,1:6),DR=$S($P($G(^AUTTSITE(1,0)),U,22):53.5,1:2),DIQ="XBX"
|
|---|
| 37 | D EN^DIQ1
|
|---|
| 38 | I $P($G(^AUTTSITE(1,0)),U,22) S XBX=$S($G(FORM)="I":$G(XBX(200,XBY,"53.5","I")),1:$G(XBX(200,XBY,"53.5")))
|
|---|
| 39 | I '$P($G(^AUTTSITE(1,0)),U,22) S XBX=$S($G(FORM)="I":$G(XBX(6,XBY,"2","I")),1:$G(XBX(6,XBY,"2")))
|
|---|
| 40 | I XBX="" Q "???"
|
|---|
| 41 | Q XBX
|
|---|
| 42 | ;
|
|---|
| 43 | PCCPPCLC(XBVISIT) ;PEP - Return a visit's primary provider class (CODE)
|
|---|
| 44 | NEW X,Y,Z,XBX,DIC,DR,DA,DIQ,XBCODE,XBY,XBN
|
|---|
| 45 | S XBX=0
|
|---|
| 46 | F S XBX=$O(^AUPNVPRV("AD",XBVISIT,XBX)) Q:XBX'=+XBX I $P(^AUPNVPRV(XBX,0),U,4)="P" S XBY=+^AUPNVPRV(XBX,0) Q
|
|---|
| 47 | I '$G(XBY) Q "???"
|
|---|
| 48 | S DA=XBY,DIC=200,DR="53.5",DIQ="XBX",DIQ(0)="I"
|
|---|
| 49 | D EN^DIQ1
|
|---|
| 50 | S XBX=$G(XBX(200,XBY,"53.5","I"))
|
|---|
| 51 | Q:XBX="" "???"
|
|---|
| 52 | S DIC=7,DR="9999999.01",DA=XBX,DIQ="XBCODE"
|
|---|
| 53 | D EN^DIQ1
|
|---|
| 54 | S XBX=XBCODE(7,XBX,"9999999.01","I")
|
|---|
| 55 | Q XBX
|
|---|
| 56 | ;
|
|---|
| 57 | PCCPPAFF(XBVISIT,FORM) ;PEP - Return a visit's primary provider (affiliation)
|
|---|
| 58 | NEW X,Y,Z,XBX,DIC,DR,DA,DIQ,XBY,XBN
|
|---|
| 59 | S XBX=0
|
|---|
| 60 | F S XBX=$O(^AUPNVPRV("AD",XBVISIT,XBX)) Q:XBX'=+XBX I $P(^AUPNVPRV(XBX,0),U,4)="P" S XBY=+^AUPNVPRV(XBX,0) Q
|
|---|
| 61 | I '$G(XBY) Q "???"
|
|---|
| 62 | S:$G(FORM)="I" DIQ(0)="I"
|
|---|
| 63 | S DA=XBY,DIC=$S($P($G(^AUTTSITE(1,0)),U,22):200,1:6),DR="9999999.01",DIQ="XBX"
|
|---|
| 64 | D EN^DIQ1
|
|---|
| 65 | I $P($G(^AUTTSITE(1,0)),U,22) S XBX=$S($G(FORM)="I":$G(XBX(200,XBY,9999999.01,"I")),1:$G(XBX(200,XBY,9999999.01)))
|
|---|
| 66 | I '$P($G(^AUTTSITE(1,0)),U,22) S XBX=$S($G(FORM)="I":$G(XBX(6,XBY,9999999.01,"I")),1:$G(XBX(6,XBY,9999999.01)))
|
|---|
| 67 | Q:XBX="" "???"
|
|---|
| 68 | Q XBX
|
|---|
| 69 | ;
|
|---|
