| [641] | 1 | XBFUNC1 ; IHS/ADC/GTH - FUNCTION LIBRARY CONTINUED ; [ 02/07/97 3:02 PM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;
|
|---|
| 4 | PROVCLS(PROV,FORM) ;PEP - Retrieve Provider Class from New Person File
|
|---|
| 5 | I $G(PROV)="" Q ""
|
|---|
| 6 | I '$D(^VA(200,PROV)) Q ""
|
|---|
| 7 | NEW X,Z,Y,CLS,DIC,DR,DA,DIQ
|
|---|
| 8 | S DIC=200,DR="53.5",DA=PROV,DIQ="CLS"
|
|---|
| 9 | S:$G(FORM)="I" DIQ(0)="I"
|
|---|
| 10 | D ENDIQ1
|
|---|
| 11 | S CLS=$S($G(FORM)="I":CLS(200,PROV,"53.5","I"),1:CLS(200,PROV,"53.5"))
|
|---|
| 12 | Q $S(CLS="":"UNKNOWN",1:CLS)
|
|---|
| 13 | ;
|
|---|
| 14 | PROVCLSC(PROV) ;PEP - Retrieve Provider Class Code given New Person File IEN
|
|---|
| 15 | I $G(PROV)="" Q ""
|
|---|
| 16 | I '$D(^VA(200,PROV)) Q ""
|
|---|
| 17 | NEW X,Z,Y,CODE,DIC,DR,DA,DIQ,CLASS
|
|---|
| 18 | S CLASS=$$PROVCLS^XBFUNC1(PROV,"I")
|
|---|
| 19 | I CLASS="UNKNOWN" Q "UNKNOWN"
|
|---|
| 20 | S DIC=7,DR="9999999.01",DA=CLASS,DIQ="CODE"
|
|---|
| 21 | D ENDIQ1
|
|---|
| 22 | S CODE=CODE(7,CLASS,"9999999.01")
|
|---|
| 23 | Q $S(CODE="":"UNKNOWN",1:CODE)
|
|---|
| 24 | ;
|
|---|
| 25 | PROVAFFL(PROV,FORM) ;PEP - Retrieve provider affiliation in int or ext format
|
|---|
| 26 | I $G(PROV)="" Q ""
|
|---|
| 27 | I '$D(^VA(200,PROV)) Q ""
|
|---|
| 28 | NEW X,Z,Y,AFFL,DIC,DR,DA,DIQ
|
|---|
| 29 | S DIC=200,DR="9999999.01",DA=PROV,DIQ="AFFL"
|
|---|
| 30 | S:$G(FORM)="I" DIQ(0)="I"
|
|---|
| 31 | D ENDIQ1
|
|---|
| 32 | S AFFL=$S($G(FORM)="I":AFFL(200,PROV,"9999999.01","I"),1:AFFL(200,PROV,"9999999.01"))
|
|---|
| 33 | Q AFFL
|
|---|
| 34 | ;
|
|---|
| 35 | PROVCODE(PROV) ;PEP - Retrieve provider code
|
|---|
| 36 | I $G(PROV)="" Q ""
|
|---|
| 37 | I '$D(^VA(200,PROV)) Q ""
|
|---|
| 38 | NEW X,Z,Y,CODE,DIC,DR,DA,DIQ
|
|---|
| 39 | S DIC=200,DR="9999999.02",DA=PROV,DIQ="CODE",DIQ(0)="E"
|
|---|
| 40 | D ENDIQ1
|
|---|
| 41 | Q CODE(200,PROV,"9999999.02","E")
|
|---|
| 42 | ;
|
|---|
| 43 | PROVINI(PROV) ;PEP - Retrieve provider initials
|
|---|
| 44 | I '$G(PROV) Q ""
|
|---|
| 45 | I '$D(^VA(200,PROV)) Q ""
|
|---|
| 46 | NEW X,Z,Y,INIT,DIC,DR,DA,DIQ
|
|---|
| 47 | S DIC=200,DR="1",DA=PROV,DIQ="INIT",DIQ(0)="E"
|
|---|
| 48 | D ENDIQ1
|
|---|
| 49 | Q INIT(200,PROV,"1","E")
|
|---|
| 50 | ;
|
|---|
| 51 | ENDIQ1 ;
|
|---|
| 52 | NEW CLASS,FORM,PROV,X,Y,Z
|
|---|
| 53 | D EN^DIQ1
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
