| 1 | SDGAF ;ALB/EDS-ROY,G - GAF Scoring Capture ; 7-10-1998
|
|---|
| 2 | ;;5.3;Scheduling;**149**;Aug 13, 1993
|
|---|
| 3 | EN(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)
|
|---|
| 8 | SCORE ;
|
|---|
| 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
|
|---|
| 15 | DATE ;
|
|---|
| 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
|
|---|
| 24 | PROV ;
|
|---|
| 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 | ;
|
|---|
| 39 | OKPROV(IEN) ; Screen for provider lookup using person class
|
|---|
| 40 | Q ($D(^XUSEC("SD GAF SCORE",IEN)))
|
|---|
| 41 | ;
|
|---|
| 42 | ABORT ;User aborted the process
|
|---|
| 43 | W !,"No Updating Done!",!
|
|---|
| 44 | K DIR
|
|---|
| 45 | S DIR(0)="E" D ^DIR K DIR
|
|---|
| 46 | Q
|
|---|
| 47 | OUT() ;Check for user abort
|
|---|
| 48 | I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) Q 1
|
|---|
| 49 | Q 0
|
|---|
| 50 | ;
|
|---|
| 51 | YN ;Yes/No Reader logic, default to No
|
|---|
| 52 | S DIR("B")="NO",DIR(0)="Y" D ^DIR K DIR("B")
|
|---|
| 53 | Q
|
|---|
