YSGAF2 ;ASF/ALB- GLOBAL ASSESSMENT OF FUNCTIONNING CONT ;11/13/97 09:09
;;5.01;MENTAL HEALTH;**33**;Dec 30, 1994
Q
EDENT ;edit /error
N %DT,DA,DIE,DIR,DIRUT,DLAYGO,DR,K,X,X1,X2,Y,G,YSDATE,YSDAYS,YSDATR,YSBY,YSENT,YSGAF
W !,"Edit Global Assessment of functioning Diagnosis",!
K DFN
D ^YSLRP Q:'$D(DFN)
I '$D(^YSD(627.8,"AX5",DFN)) W !,"No previous GAF on record for this patient",!,"Please enter any new GAF data through the entry options",! H 2 Q
D LST
I '$D(^TMP("YSGAF",$J)) W !!,"No Axis 5 dx's by "_$P(^VA(200,DUZ,0),U) H 1 Q
D SHOW,SEL
Q:$D(DIRUT)!(Y'>0)
D APART
I YSDAYS>2 D
. W !,"Dx made ",YSDAYS," days ago and cannot be changed. Do you wish to mark it as an error? "
. K DIR S DIR(0)="Y",DIR("B")="No" D ^DIR Q:$D(DIRUT)
. I Y D NOW^%DTC S Y=% X ^DD("DD") S DIE="^YSD(627.8,",DR="80///Error: entered in error noted on "_Y_" by "_$P(^VA(200,DUZ,0),U),DA=+G D ^DIE
. Q
I YSDAYS<3 D
. S DIE="^YSD(627.8,",DR=65,DA=+G D ^DIE
. Q
Q
SHOW ; display dxs
W !!
S K=0 F S K=$O(^TMP("YSGAF",$J,K)) Q:K'>0 D
. W:($X>45) !
. W $J(K,3),". GAF:",$J($P(^TMP("YSGAF",$J,K),U,3),3)_" on "
. S Y=$P(^TMP("YSGAF",$J,K),U,2) X ^DD("DD") W Y
. W ?40
Q
LST ;LIST AXIS 5 FOR CURRENT PT AND DUZ
K ^TMP("YSGAF",$J) S YSENT=0
S YSDATR=0 F S YSDATR=$O(^YSD(627.8,"AX5",DFN,YSDATR)) Q:YSDATR'>0 S DA=0 F S DA=$O(^YSD(627.8,"AX5",DFN,YSDATR,DA)) Q:DA'>0 D
. S YSGAF=$P($G(^YSD(627.8,DA,60)),U,3) Q:YSGAF'>0
. S YSBY=$P(^YSD(627.8,DA,0),U,4) Q:YSBY'=DUZ
. Q:$L($G(^YSD(627.8,DA,80,1,0)))
. S YSENT=YSENT+1
. S ^TMP("YSGAF",$J,YSENT)=DA_U_$P(^YSD(627.8,DA,0),U,3)_U_YSGAF
Q
SEL ;select dx
K DIR S DIR(0)="N^1:"_YSENT_":0",DIR("A")="Select GAF to edit: ",DIR("B")=1
D ^DIR
Q
APART ;time since dx
S G=^TMP("YSGAF",$J,Y)
D NOW^%DTC S X1=%,X2=$P(G,U,2) D ^%DTC S YSDAYS=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSGAF2 1845 printed Oct 16, 2024@18:15:15 Page 2
YSGAF2 ;ASF/ALB- GLOBAL ASSESSMENT OF FUNCTIONNING CONT ;11/13/97 09:09
+1 ;;5.01;MENTAL HEALTH;**33**;Dec 30, 1994
+2 QUIT
EDENT ;edit /error
+1 NEW %DT,DA,DIE,DIR,DIRUT,DLAYGO,DR,K,X,X1,X2,Y,G,YSDATE,YSDAYS,YSDATR,YSBY,YSENT,YSGAF
+2 WRITE !,"Edit Global Assessment of functioning Diagnosis",!
+3 KILL DFN
+4 DO ^YSLRP
if '$DATA(DFN)
QUIT
+5 IF '$DATA(^YSD(627.8,"AX5",DFN))
WRITE !,"No previous GAF on record for this patient",!,"Please enter any new GAF data through the entry options",!
HANG 2
QUIT
+6 DO LST
+7 IF '$DATA(^TMP("YSGAF",$JOB))
WRITE !!,"No Axis 5 dx's by "_$PIECE(^VA(200,DUZ,0),U)
HANG 1
QUIT
+8 DO SHOW
DO SEL
+9 if $DATA(DIRUT)!(Y'>0)
QUIT
+10 DO APART
+11 IF YSDAYS>2
Begin DoDot:1
+12 WRITE !,"Dx made ",YSDAYS," days ago and cannot be changed. Do you wish to mark it as an error? "
+13 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="No"
DO ^DIR
if $DATA(DIRUT)
QUIT
+14 IF Y
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET DIE="^YSD(627.8,"
SET DR="80///Error: entered in error noted on "_Y_" by "_$PIECE(^VA(200,DUZ,0),U)
SET DA=+G
DO ^DIE
+15 QUIT
End DoDot:1
+16 IF YSDAYS<3
Begin DoDot:1
+17 SET DIE="^YSD(627.8,"
SET DR=65
SET DA=+G
DO ^DIE
+18 QUIT
End DoDot:1
+19 QUIT
SHOW ; display dxs
+1 WRITE !!
+2 SET K=0
FOR
SET K=$ORDER(^TMP("YSGAF",$JOB,K))
if K'>0
QUIT
Begin DoDot:1
+3 if ($X>45)
WRITE !
+4 WRITE $JUSTIFY(K,3),". GAF:",$JUSTIFY($PIECE(^TMP("YSGAF",$JOB,K),U,3),3)_" on "
+5 SET Y=$PIECE(^TMP("YSGAF",$JOB,K),U,2)
XECUTE ^DD("DD")
WRITE Y
+6 WRITE ?40
End DoDot:1
+7 QUIT
LST ;LIST AXIS 5 FOR CURRENT PT AND DUZ
+1 KILL ^TMP("YSGAF",$JOB)
SET YSENT=0
+2 SET YSDATR=0
FOR
SET YSDATR=$ORDER(^YSD(627.8,"AX5",DFN,YSDATR))
if YSDATR'>0
QUIT
SET DA=0
FOR
SET DA=$ORDER(^YSD(627.8,"AX5",DFN,YSDATR,DA))
if DA'>0
QUIT
Begin DoDot:1
+3 SET YSGAF=$PIECE($GET(^YSD(627.8,DA,60)),U,3)
if YSGAF'>0
QUIT
+4 SET YSBY=$PIECE(^YSD(627.8,DA,0),U,4)
if YSBY'=DUZ
QUIT
+5 if $LENGTH($GET(^YSD(627.8,DA,80,1,0)))
QUIT
+6 SET YSENT=YSENT+1
+7 SET ^TMP("YSGAF",$JOB,YSENT)=DA_U_$PIECE(^YSD(627.8,DA,0),U,3)_U_YSGAF
End DoDot:1
+8 QUIT
SEL ;select dx
+1 KILL DIR
SET DIR(0)="N^1:"_YSENT_":0"
SET DIR("A")="Select GAF to edit: "
SET DIR("B")=1
+2 DO ^DIR
+3 QUIT
APART ;time since dx
+1 SET G=^TMP("YSGAF",$JOB,Y)
+2 DO NOW^%DTC
SET X1=%
SET X2=$PIECE(G,U,2)
DO ^%DTC
SET YSDAYS=X
+3 QUIT
