- 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 Feb 19, 2025@00:24:30 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