YSGAFAP1 ;ALB/ASF-GLOBAL ASSESSMENT OF FUNCTIONING ;2/4/00 13:55
;;5.01;MENTAL HEALTH;**64**;Dec 30, 1994
Q
ENT(YSDATA,YS) ;Enter GAF information
; DFN - Patient IEN
; GAF - GAF Score (Axis 5)
; DATE - Date/Time of Diagnosis
; STAFF - Diagnosis By DUZ
PARSE ;
S YSPN=$G(YS("DFN"))
S YSGN=$G(YS("GAF"))
S YSGD=$G(YS("DATE"),"NOW") S X=YSGD,%DT="T" D ^%DT S YSGD=Y
S YSGC=$G(YS("STAFF"))
IF YSPN'>0!('$D(^DPT(YSPN,0))) S YSDATA(1)="[ERROR]",YSDATA(2)="bad DFN" Q ;------->
IF YSGC'>0!('$D(^VA(200,YSGC,0))) S YSDATA(1)="[ERROR]",YSDATA(2)="bad staff" Q ;---->
IF YSGN'?1N.N!(YSGN<1)!(YSGN>100) S YSDATA(1)="[ERROR]",YSDATA(2)="bad dx" Q ;----->
IF YSGD<0 S YSDATA(1)="[ERROR]",YSDATA(2)="bad date" Q ;---->
;
SET K DD,DO,DA,DINUM
S DLAYGO=627.8,X="NOW",%DT="TR" D ^%DT S X=Y
S DIC="^YSD(627.8,",DIC(0)="L"
D FILE^DICN Q:Y'>0 S YSDA=+Y
S DFN=+YSPN
D PATSTAT^YSDX3B
I '$D(DFN) D QUIT ;--->
. D EN^YSGAFOBX(YSDA)
S DIE="^YSD(627.8,",DA=YSDA
S DR=".02////"_YSPN_";.03////"_YSGD_";.04////"_YSGC_";.05////"_DUZ
S DR=DR_";65////"_YSGN_";66////"_YSSTAT
L +^YSD(627.8,YSDA):9999 Q:'$T
D ^DIE
L -^YSD(627.8,YSDA)
K YSDATA S YSDATA(1)="[DATA]"
D EN^YSGAFOBX(YSDA)
K %DT,DA,DIC,DIE,DLAYGO,DR,X,Y,YSDA,YSPN,YSGN,YSGD,YSGC,YSSTAT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSGAFAP1 1293 printed Oct 16, 2024@18:15:15 Page 2
YSGAFAP1 ;ALB/ASF-GLOBAL ASSESSMENT OF FUNCTIONING ;2/4/00 13:55
+1 ;;5.01;MENTAL HEALTH;**64**;Dec 30, 1994
+2 QUIT
ENT(YSDATA,YS) ;Enter GAF information
+1 ; DFN - Patient IEN
+2 ; GAF - GAF Score (Axis 5)
+3 ; DATE - Date/Time of Diagnosis
+4 ; STAFF - Diagnosis By DUZ
PARSE ;
+1 SET YSPN=$GET(YS("DFN"))
+2 SET YSGN=$GET(YS("GAF"))
+3 SET YSGD=$GET(YS("DATE"),"NOW")
SET X=YSGD
SET %DT="T"
DO ^%DT
SET YSGD=Y
+4 SET YSGC=$GET(YS("STAFF"))
+5 ;------->
IF YSPN'>0!('$DATA(^DPT(YSPN,0)))
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="bad DFN"
QUIT
+6 ;---->
IF YSGC'>0!('$DATA(^VA(200,YSGC,0)))
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="bad staff"
QUIT
+7 ;----->
IF YSGN'?1N.N!(YSGN<1)!(YSGN>100)
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="bad dx"
QUIT
+8 ;---->
IF YSGD<0
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="bad date"
QUIT
+9 ;
SET KILL DD,DO,DA,DINUM
+1 SET DLAYGO=627.8
SET X="NOW"
SET %DT="TR"
DO ^%DT
SET X=Y
+2 SET DIC="^YSD(627.8,"
SET DIC(0)="L"
+3 DO FILE^DICN
if Y'>0
QUIT
SET YSDA=+Y
+4 SET DFN=+YSPN
+5 DO PATSTAT^YSDX3B
+6 ;--->
IF '$DATA(DFN)
Begin DoDot:1
+7 DO EN^YSGAFOBX(YSDA)
End DoDot:1
QUIT
+8 SET DIE="^YSD(627.8,"
SET DA=YSDA
+9 SET DR=".02////"_YSPN_";.03////"_YSGD_";.04////"_YSGC_";.05////"_DUZ
+10 SET DR=DR_";65////"_YSGN_";66////"_YSSTAT
+11 LOCK +^YSD(627.8,YSDA):9999
if '$TEST
QUIT
+12 DO ^DIE
+13 LOCK -^YSD(627.8,YSDA)
+14 KILL YSDATA
SET YSDATA(1)="[DATA]"
+15 DO EN^YSGAFOBX(YSDA)
+16 KILL %DT,DA,DIC,DIE,DLAYGO,DR,X,Y,YSDA,YSPN,YSGN,YSGD,YSGC,YSSTAT
+17 QUIT
