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

YSGAFAP1.m

Go to the documentation of this file.
  1. YSGAFAP1 ;ALB/ASF-GLOBAL ASSESSMENT OF FUNCTIONING ;2/4/00 13:55
  1. ;;5.01;MENTAL HEALTH;**64**;Dec 30, 1994
  1. Q
  1. ENT(YSDATA,YS) ;Enter GAF information
  1. ; DFN - Patient IEN
  1. ; GAF - GAF Score (Axis 5)
  1. ; DATE - Date/Time of Diagnosis
  1. ; STAFF - Diagnosis By DUZ
  1. PARSE ;
  1. S YSPN=$G(YS("DFN"))
  1. S YSGN=$G(YS("GAF"))
  1. S YSGD=$G(YS("DATE"),"NOW") S X=YSGD,%DT="T" D ^%DT S YSGD=Y
  1. S YSGC=$G(YS("STAFF"))
  1. IF YSPN'>0!('$D(^DPT(YSPN,0))) S YSDATA(1)="[ERROR]",YSDATA(2)="bad DFN" Q ;------->
  1. IF YSGC'>0!('$D(^VA(200,YSGC,0))) S YSDATA(1)="[ERROR]",YSDATA(2)="bad staff" Q ;---->
  1. IF YSGN'?1N.N!(YSGN<1)!(YSGN>100) S YSDATA(1)="[ERROR]",YSDATA(2)="bad dx" Q ;----->
  1. IF YSGD<0 S YSDATA(1)="[ERROR]",YSDATA(2)="bad date" Q ;---->
  1. ;
  1. SET K DD,DO,DA,DINUM
  1. S DLAYGO=627.8,X="NOW",%DT="TR" D ^%DT S X=Y
  1. S DIC="^YSD(627.8,",DIC(0)="L"
  1. D FILE^DICN Q:Y'>0 S YSDA=+Y
  1. S DFN=+YSPN
  1. D PATSTAT^YSDX3B
  1. I '$D(DFN) D QUIT ;--->
  1. . D EN^YSGAFOBX(YSDA)
  1. S DIE="^YSD(627.8,",DA=YSDA
  1. S DR=".02////"_YSPN_";.03////"_YSGD_";.04////"_YSGC_";.05////"_DUZ
  1. S DR=DR_";65////"_YSGN_";66////"_YSSTAT
  1. L +^YSD(627.8,YSDA):9999 Q:'$T
  1. D ^DIE
  1. L -^YSD(627.8,YSDA)
  1. K YSDATA S YSDATA(1)="[DATA]"
  1. D EN^YSGAFOBX(YSDA)
  1. K %DT,DA,DIC,DIE,DLAYGO,DR,X,Y,YSDA,YSPN,YSGN,YSGD,YSGC,YSSTAT
  1. Q