SDGAF.m

SDGAF ;ALB/EDS-ROY,G - GAF Scoring Capture ; 7-10-1998

 ;;5.3;Scheduling;**149,1015**;Aug 13, 1993;Build 21

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

SDGAF     ;ALB/EDS-ROY,G - GAF Scoring Capture ; 7-10-1998

 +1       ;;5.3;Scheduling;**149,1015**;Aug 13, 1993;Build 21

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