| [613] | 1 | IBDFN16 ;ALB/DHH - ENCOUNTER FORM - (entry points for gaf project) ;3/20/2001
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;**37**;APR 24, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | GAFPROV ;Enter GAF Score Provider
|
|---|
| 5 | ;
|
|---|
| 6 | ; -- @IBARY should be defined
|
|---|
| 7 | ;
|
|---|
| 8 | N DIC,Y,DIROUT,DIRUT,DTOUT,DUOUT
|
|---|
| 9 | S DIC=200,DIC(0)="AEQM"
|
|---|
| 10 | S DIC("S")="I $$OKPROV^IBDFDE23(Y)"
|
|---|
| 11 | S DIC("A")="Provider determining GAF Score: " D ^DIC K DIC
|
|---|
| 12 | I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) Q
|
|---|
| 13 | I Y<0 Q
|
|---|
| 14 | S @IBARY=Y
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | OKPROV(IEN) ; Screen for provider lookup using person class
|
|---|
| 18 | ; provider for gaf must have the sd gaf score security key
|
|---|
| 19 | ;
|
|---|
| 20 | Q ($D(^XUSEC("SD GAF SCORE",IEN)))
|
|---|
| 21 | ;
|
|---|
| 22 | GAFRET ;Previous GAF information returned from Mental Health
|
|---|
| 23 | ;
|
|---|
| 24 | ; -- this is to be used by PREVIOUS GAF SCORE package interface
|
|---|
| 25 | ;
|
|---|
| 26 | N GAFDAT,Y,GAFPROV,X,X1,X2,IBX
|
|---|
| 27 | S IBX=$$RET^YSGAF($G(DFN))
|
|---|
| 28 | I +IBX=-1 S @IBARY="" Q
|
|---|
| 29 | S GAFDAT=$P(IBX,"^",2)
|
|---|
| 30 | S Y=GAFDAT K %DT D DD^%DT S $P(IBX,"^",2)=$P(Y,"@")
|
|---|
| 31 | S GAFPROV=$P($G(^VA(200,+$P(IBX,"^",3),0)),"^")
|
|---|
| 32 | S $P(IBX,"^",3)=GAFPROV
|
|---|
| 33 | S $P(IBX,"^",4)=$$RULE(GAFDAT)
|
|---|
| 34 | S @IBARY=IBX
|
|---|
| 35 | Q
|
|---|
| 36 | RULE(GAFDAT) ;check for greater than 90 days
|
|---|
| 37 | ;
|
|---|
| 38 | ; -- gafdat is the internal date of the last gaf score
|
|---|
| 39 | ;
|
|---|
| 40 | N RULE
|
|---|
| 41 | S RULE="NO"
|
|---|
| 42 | S X1=DT,X2=GAFDAT D ^%DTC
|
|---|
| 43 | S:X>90 RULE="YES"
|
|---|
| 44 | Q RULE
|
|---|
