source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDGAF.m@ 724

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

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1SDGAF ;ALB/EDS-ROY,G - GAF Scoring Capture ; 7-10-1998
2 ;;5.3;Scheduling;**149**;Aug 13, 1993
3EN(DFN) ;Entry point for getting prior GAF data and updating
4 K DTOUT,DUOUT,DIRUT,DIROUT
5 N SDGAF,SDGAFDT,SDNGAFDT,SDGAFSC,SDNGAFSC,SDGAFPR,SDNGAFPR,DIR
6 S SDGAF=$$NEWGAF^SDUTL2(DFN)
7 S SDGAFDT=$P(SDGAF,"^",3),SDGAFSC=$P(SDGAF,"^",2),SDGAFPR=$P(SDGAF,"^",4)
8SCORE ;
9 S DIR("A")="GAF Score",DIR(0)="N^1:100:0"
10 D ^DIR K DIR G:$$OUT() ABORT
11 S SDNGAFSC=Y
12 S DIR("A")="Is this the correct GAF Score"
13 D YN G:$$OUT() ABORT
14 G:'Y SCORE
15DATE ;
16 S DIR("A")="Date/Time of New GAF Score"
17 S DIR(0)="D^"_$S(SDGAFDT]"":SDGAFDT,1:"")_":NOW:EXT"
18 S DIR("B")="NOW"
19 D ^DIR K DIR("B") G:$$OUT() ABORT
20 S SDNGAFDT=Y
21 S DIR("A")="Is this the correct Date/Time"
22 D YN G:$$OUT() ABORT
23 G:'Y DATE
24PROV ;
25 S DIC=200,DIC(0)="AEQM"
26 S DIC("S")="I $$OKPROV^SDGAF(Y)"
27 S DIC("A")="Provider determining GAF Score: " D ^DIC K DIC
28 G:$$OUT() ABORT
29 I Y<0 W !,"You must enter a Provider!" G PROV
30 S SDNGAFPR=+Y
31 S DIR("A")="Is this the correct Provider"
32 D YN G:$$OUT() ABORT
33 G:'Y PROV
34 S DIR("A")="Is the information entered correct",DIR(0)="Y",DIR("B")="YES" D ^DIR K DIR G:$$OUT() ABORT
35 G:'Y SCORE
36 D UPD^YSGAF(DFN,SDNGAFSC,SDNGAFDT,SDNGAFPR,"O")
37 Q
38 ;
39OKPROV(IEN) ; Screen for provider lookup using person class
40 Q ($D(^XUSEC("SD GAF SCORE",IEN)))
41 ;
42ABORT ;User aborted the process
43 W !,"No Updating Done!",!
44 K DIR
45 S DIR(0)="E" D ^DIR K DIR
46 Q
47OUT() ;Check for user abort
48 I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) Q 1
49 Q 0
50 ;
51YN ;Yes/No Reader logic, default to No
52 S DIR("B")="NO",DIR(0)="Y" D ^DIR K DIR("B")
53 Q
Note: See TracBrowser for help on using the repository browser.