source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFN16.m@ 1608

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

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1IBDFN16 ;ALB/DHH - ENCOUNTER FORM - (entry points for gaf project) ;3/20/2001
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**37**;APR 24, 1997
3 ;
4GAFPROV ;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 ;
17OKPROV(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 ;
22GAFRET ;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
36RULE(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
Note: See TracBrowser for help on using the repository browser.