| 1 | IBDF18B ;ALB/AAS - ENCOUNTER FORM - utilities for PCE ;04-OCT-94
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | GETPRO(CLINIC,ARY) ; -- returns list of providers specified for a clinic
|
|---|
| 5 | ; -- input CLINIC = pointer to hospital location file for clinic
|
|---|
| 6 | ; ARY = name of array to return list in
|
|---|
| 7 | ;
|
|---|
| 8 | ; -- output The format of the returned array is as follows
|
|---|
| 9 | ; @ARY@(0) = count of array element (0 of nothing found)
|
|---|
| 10 | ; @ARY@(1) = pointer to 200^provider name from 200 (default provider if indicated)
|
|---|
| 11 | ; @ARY@(2) = pointer to 200^provider name from 200
|
|---|
| 12 | ;
|
|---|
| 13 | N I,J,X,Y,IBX,IBQUIT,COUNT,IBC,ERR,CT
|
|---|
| 14 | S (CT,COUNT,IBQUIT)=0
|
|---|
| 15 | ;
|
|---|
| 16 | S @ARY@(0)=""
|
|---|
| 17 | I $G(CLINIC)="" G GETPROQ
|
|---|
| 18 | I $G(^SC(CLINIC,0))="" G GETPROQ
|
|---|
| 19 | S ERR="IBDERR"
|
|---|
| 20 | ;
|
|---|
| 21 | ; -- don't use PCMM providers checked
|
|---|
| 22 | I $P($G(^SD(409.95,+$O(^SD(409.95,"B",CLINIC,0)),0)),"^",10) G CLIN
|
|---|
| 23 | ;
|
|---|
| 24 | ; -- get providers from PCMM teams, if available
|
|---|
| 25 | I $L($T(PRCL^SCAPMC)) S X=$$PRCL^SCAPMC(.CLINIC,"","","","",ARY,ERR) I @ARY@(0)>0 D
|
|---|
| 26 | .K @ARY@("SCPR")
|
|---|
| 27 | .F I=1:1:@ARY@(0) I '$$SCREEN^IBDFDE10(+@ARY@(I)) K @ARY@(I) S CT=CT+1
|
|---|
| 28 | .S @ARY@(0)=@ARY@(0)-CT
|
|---|
| 29 | I @ARY@(0)>0 G GETPROQ
|
|---|
| 30 | ;
|
|---|
| 31 | CLIN I $O(^SC(CLINIC,"PR",0))="" G GETPROQ
|
|---|
| 32 | ;
|
|---|
| 33 | ; -- default provider should always be listed first
|
|---|
| 34 | S IBX=$O(^SC("ADPR",CLINIC,0)) I IBX D
|
|---|
| 35 | .S X=$G(^SC(CLINIC,"PR",IBX,0))
|
|---|
| 36 | .D INCPR(+X)
|
|---|
| 37 | ;
|
|---|
| 38 | ; -- get rest of list of providers
|
|---|
| 39 | S IBX=0 F S IBX=$O(^SC(CLINIC,"PR",IBX)) Q:'IBX I IBX D
|
|---|
| 40 | .S X=$G(^SC(CLINIC,"PR",IBX,0))
|
|---|
| 41 | .D INCPR(+X)
|
|---|
| 42 | S @ARY@(0)=COUNT
|
|---|
| 43 | ;
|
|---|
| 44 | GETPROQ Q
|
|---|
| 45 | ;
|
|---|
| 46 | INCPR(X) ; -- increment counter and set provider array
|
|---|
| 47 | Q:'X!($G(^VA(200,+X,0))="")
|
|---|
| 48 | Q:$D(IBX(+X)) ; -- already set
|
|---|
| 49 | S COUNT=COUNT+1,@ARY@(COUNT)=+X_"^"_$P(^VA(200,+X,0),"^")
|
|---|
| 50 | S IBX(+X)=""
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | TEST K ALAN D GETPRO(25,"ALAN")
|
|---|
| 54 | X "ZW ALAN"
|
|---|
| 55 | Q
|
|---|
