Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDGAF

SDGAF.m

Go to the documentation of this file.
  1. SDGAF ;ALB/EDS-ROY,G - GAF Scoring Capture ; 7-10-1998
  1. ;;5.3;Scheduling;**149**;Aug 13, 1993
  1. EN(DFN) ;Entry point for getting prior GAF data and updating
  1. K DTOUT,DUOUT,DIRUT,DIROUT
  1. N SDGAF,SDGAFDT,SDNGAFDT,SDGAFSC,SDNGAFSC,SDGAFPR,SDNGAFPR,DIR
  1. S SDGAF=$$NEWGAF^SDUTL2(DFN)
  1. S SDGAFDT=$P(SDGAF,"^",3),SDGAFSC=$P(SDGAF,"^",2),SDGAFPR=$P(SDGAF,"^",4)
  1. SCORE ;
  1. S DIR("A")="GAF Score",DIR(0)="N^1:100:0"
  1. D ^DIR K DIR G:$$OUT() ABORT
  1. S SDNGAFSC=Y
  1. S DIR("A")="Is this the correct GAF Score"
  1. D YN G:$$OUT() ABORT
  1. G:'Y SCORE
  1. DATE ;
  1. S DIR("A")="Date/Time of New GAF Score"
  1. S DIR(0)="D^"_$S(SDGAFDT]"":SDGAFDT,1:"")_":NOW:EXT"
  1. S DIR("B")="NOW"
  1. D ^DIR K DIR("B") G:$$OUT() ABORT
  1. S SDNGAFDT=Y
  1. S DIR("A")="Is this the correct Date/Time"
  1. D YN G:$$OUT() ABORT
  1. G:'Y DATE
  1. PROV ;
  1. S DIC=200,DIC(0)="AEQM"
  1. S DIC("S")="I $$OKPROV^SDGAF(Y)"
  1. S DIC("A")="Provider determining GAF Score: " D ^DIC K DIC
  1. G:$$OUT() ABORT
  1. I Y<0 W !,"You must enter a Provider!" G PROV
  1. S SDNGAFPR=+Y
  1. S DIR("A")="Is this the correct Provider"
  1. D YN G:$$OUT() ABORT
  1. G:'Y PROV
  1. S DIR("A")="Is the information entered correct",DIR(0)="Y",DIR("B")="YES" D ^DIR K DIR G:$$OUT() ABORT
  1. G:'Y SCORE
  1. D UPD^YSGAF(DFN,SDNGAFSC,SDNGAFDT,SDNGAFPR,"O")
  1. Q
  1. ;
  1. OKPROV(IEN) ; Screen for provider lookup using person class
  1. Q ($D(^XUSEC("SD GAF SCORE",IEN)))
  1. ;
  1. ABORT ;User aborted the process
  1. W !,"No Updating Done!",!
  1. K DIR
  1. S DIR(0)="E" D ^DIR K DIR
  1. Q
  1. OUT() ;Check for user abort
  1. I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) Q 1
  1. Q 0
  1. ;
  1. YN ;Yes/No Reader logic, default to No
  1. S DIR("B")="NO",DIR(0)="Y" D ^DIR K DIR("B")
  1. Q