SDGAF ;ALB/EDS-ROY,G - GAF Scoring Capture ; 7-10-1998
;;5.3;Scheduling;**149**;Aug 13, 1993
EN(DFN) ;Entry point for getting prior GAF data and updating
K DTOUT,DUOUT,DIRUT,DIROUT
N SDGAF,SDGAFDT,SDNGAFDT,SDGAFSC,SDNGAFSC,SDGAFPR,SDNGAFPR,DIR
S SDGAF=$$NEWGAF^SDUTL2(DFN)
S SDGAFDT=$P(SDGAF,"^",3),SDGAFSC=$P(SDGAF,"^",2),SDGAFPR=$P(SDGAF,"^",4)
SCORE ;
S DIR("A")="GAF Score",DIR(0)="N^1:100:0"
D ^DIR K DIR G:$$OUT() ABORT
S SDNGAFSC=Y
S DIR("A")="Is this the correct GAF Score"
D YN G:$$OUT() ABORT
G:'Y SCORE
DATE ;
S DIR("A")="Date/Time of New GAF Score"
S DIR(0)="D^"_$S(SDGAFDT]"":SDGAFDT,1:"")_":NOW:EXT"
S DIR("B")="NOW"
D ^DIR K DIR("B") G:$$OUT() ABORT
S SDNGAFDT=Y
S DIR("A")="Is this the correct Date/Time"
D YN G:$$OUT() ABORT
G:'Y DATE
PROV ;
S DIC=200,DIC(0)="AEQM"
S DIC("S")="I $$OKPROV^SDGAF(Y)"
S DIC("A")="Provider determining GAF Score: " D ^DIC K DIC
G:$$OUT() ABORT
I Y<0 W !,"You must enter a Provider!" G PROV
S SDNGAFPR=+Y
S DIR("A")="Is this the correct Provider"
D YN G:$$OUT() ABORT
G:'Y PROV
S DIR("A")="Is the information entered correct",DIR(0)="Y",DIR("B")="YES" D ^DIR K DIR G:$$OUT() ABORT
G:'Y SCORE
D UPD^YSGAF(DFN,SDNGAFSC,SDNGAFDT,SDNGAFPR,"O")
Q
;
OKPROV(IEN) ; Screen for provider lookup using person class
Q ($D(^XUSEC("SD GAF SCORE",IEN)))
;
ABORT ;User aborted the process
W !,"No Updating Done!",!
K DIR
S DIR(0)="E" D ^DIR K DIR
Q
OUT() ;Check for user abort
I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) Q 1
Q 0
;
YN ;Yes/No Reader logic, default to No
S DIR("B")="NO",DIR(0)="Y" D ^DIR K DIR("B")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDGAF 1649 printed Oct 16, 2024@18:58:23 Page 2
SDGAF ;ALB/EDS-ROY,G - GAF Scoring Capture ; 7-10-1998
+1 ;;5.3;Scheduling;**149**;Aug 13, 1993
EN(DFN) ;Entry point for getting prior GAF data and updating
+1 KILL DTOUT,DUOUT,DIRUT,DIROUT
+2 NEW SDGAF,SDGAFDT,SDNGAFDT,SDGAFSC,SDNGAFSC,SDGAFPR,SDNGAFPR,DIR
+3 SET SDGAF=$$NEWGAF^SDUTL2(DFN)
+4 SET SDGAFDT=$PIECE(SDGAF,"^",3)
SET SDGAFSC=$PIECE(SDGAF,"^",2)
SET SDGAFPR=$PIECE(SDGAF,"^",4)
SCORE ;
+1 SET DIR("A")="GAF Score"
SET DIR(0)="N^1:100:0"
+2 DO ^DIR
KILL DIR
if $$OUT()
GOTO ABORT
+3 SET SDNGAFSC=Y
+4 SET DIR("A")="Is this the correct GAF Score"
+5 DO YN
if $$OUT()
GOTO ABORT
+6 if 'Y
GOTO SCORE
DATE ;
+1 SET DIR("A")="Date/Time of New GAF Score"
+2 SET DIR(0)="D^"_$SELECT(SDGAFDT]"":SDGAFDT,1:"")_":NOW:EXT"
+3 SET DIR("B")="NOW"
+4 DO ^DIR
KILL DIR("B")
if $$OUT()
GOTO ABORT
+5 SET SDNGAFDT=Y
+6 SET DIR("A")="Is this the correct Date/Time"
+7 DO YN
if $$OUT()
GOTO ABORT
+8 if 'Y
GOTO DATE
PROV ;
+1 SET DIC=200
SET DIC(0)="AEQM"
+2 SET DIC("S")="I $$OKPROV^SDGAF(Y)"
+3 SET DIC("A")="Provider determining GAF Score: "
DO ^DIC
KILL DIC
+4 if $$OUT()
GOTO ABORT
+5 IF Y<0
WRITE !,"You must enter a Provider!"
GOTO PROV
+6 SET SDNGAFPR=+Y
+7 SET DIR("A")="Is this the correct Provider"
+8 DO YN
if $$OUT()
GOTO ABORT
+9 if 'Y
GOTO PROV
+10 SET DIR("A")="Is the information entered correct"
SET DIR(0)="Y"
SET DIR("B")="YES"
DO ^DIR
KILL DIR
if $$OUT()
GOTO ABORT
+11 if 'Y
GOTO SCORE
+12 DO UPD^YSGAF(DFN,SDNGAFSC,SDNGAFDT,SDNGAFPR,"O")
+13 QUIT
+14 ;
OKPROV(IEN) ; Screen for provider lookup using person class
+1 QUIT ($DATA(^XUSEC("SD GAF SCORE",IEN)))
+2 ;
ABORT ;User aborted the process
+1 WRITE !,"No Updating Done!",!
+2 KILL DIR
+3 SET DIR(0)="E"
DO ^DIR
KILL DIR
+4 QUIT
OUT() ;Check for user abort
+1 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))
QUIT 1
+2 QUIT 0
+3 ;
YN ;Yes/No Reader logic, default to No
+1 SET DIR("B")="NO"
SET DIR(0)="Y"
DO ^DIR
KILL DIR("B")
+2 QUIT
