YSGAFAP1.m

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 ---YSGAFAP1   1293     printed  Apr 09, 2024@21:24:54                                                                                                                                                                                                    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