YSDX3B ;SLC/DJP-Entry of Axis 4 & Axis 5 Diagnoses for the Mental Health Medical Record ;8/29/89 08:51
;;5.01;MENTAL HEALTH;**33,43,49**;Dec 30, 1994
;D RECORD^YSDX0001("YSDX3B^YSDX3B") ;Used for testing. Inactivated in YSDX0001...
;
AXIS4 ; Called by routine YSCEN1, YSDX3
; Entry of Axis 4 information
;D RECORD^YSDX0001("AXIS4^YSDX3B") ;Used for testing. Inactivated in YSDX0001...
W !!,"AXIS 4",!,"------"
AX43 ;
;D RECORD^YSDX0001("AX43^YSDX3B") ;Used for testing. Inactivated in YSDX0001...
W !!,"Enter PSYCHOSOCIAL STRESSOR: " R X3:DTIME S YSTOUT='$T,YSUOUT=X3["^" I YSTOUT!YSUOUT S YSQT=1 Q
Q:X3="" I X3="?" D AX41 K X3 G AX43
I X3["??" S XQH="YS-PSYCHOSOCIAL STRESSORS" D EN^XQH K X3 G AX43
I $L(X3)>60!($L(X3)<1) D AX41 K X3 G AX43
AX42 ;
;D RECORD^YSDX0001("AX42^YSDX3B") ;Used for testing. Inactivated in YSDX0001...
W !,"Enter SEVERITY CODE: " R X4:DTIME S YSTOUT='$T,YSUOUT=X4["^" I YSTOUT!YSUOUT S YSQT=1 Q
I X4="??" S XQH="YS-AXIS 4" D EN^XQH K X4 G AX42
I X4'?1N!(X4<0)!(X4>6) D AX4 G AX42
S X6=$S(X4=1:"NONE",X4=2:"MILD",X4=3:"MODERATE",X4=4:"SEVERE",X4=5:"EXTREME",X4=6:"CATASTROPHIC",X4=0:"INADEQUATE INFORMATION OR NO CHANGE IN CONDITION",1:"") W " "_X6
S DIC="^YSD(627.8,",DIC(0)="L",X="""N""",DLAYGO=627
D ^DIC Q:Y'>0 S YSDA=+Y
S YSDUZ=$P(^VA(200,DUZ,0),U),DIE="^YSD(627.8,",DA=YSDA,DR=".02////"_YSDFN_";.03///^S X=""NOW"";.04///^S X=YSDUZ;.05///^S X=""`""_DUZ;60//^S X=X3;61//^S X=X4"
L +^YSD(627.8,DA):9999
K Y
D ^DIE
L -^YSD(627.8,DA)
K DA,DIC,DIE,DR
S YSTOUT=$D(DTOUT) I YSTOUT!($O(Y(""))]"") S DIK="^YSD(627.8,",DA=YSDA D ^DIK Q:YSTOUT G AX43
AX4 ;
;D RECORD^YSDX0001("AX4^YSDX3B") ;Used for testing. Inactivated in YSDX0001...
W !!,"Enter code indicating overall severity of psychosocial stressor.",! S A1=$P(^DD(627.8,61,0),U,3) F I=1:1:8 S A2=$P(A1,";",I) W !?5,$P(A2,":")_" "_$P(A2,":",2)
W !!,"Enter ""??"" for additional information on Severity Codes."
Q
AX41 ;
;D RECORD^YSDX0001("AX41^YSDX3B") ;Used for testing. Inactivated in YSDX0001...
W !!,"Enter short narrative (1-60 characters) describing source of stress."
Q
AXIS5 ; Called by routines YSCEN1, YSDX3
;D RECORD^YSDX0001("AXIS5^YSDX3B") ;Used for testing. Inactivated in YSDX0001...
;Entry of Axis 5 information
W !!,"AXIS 5",!,"------",! D GAF^YSDX3UB
AX51 ;
;D RECORD^YSDX0001("AX51^YSDX3B") ;Used for testing. Inactivated in YSDX0001...
W !!,"Enter RATING OF CURRENT FUNCTIONING: " R X5:DTIME S YSTOUT='$T,YSUOUT=X5["^" I YSTOUT!YSUOUT S YSQT=1 Q
Q:X5="" I X5="?" D AX5 K X5 G AX51
I X5["??" S XQH="YS-GAF SCALE" D EN^XQH K X5 G AX51
I X5>100!(X5<1)!(X5'?.N) D AX5 K X5 G AX51
K DD,DO,DA,DINUM
S X="NOW",%DT="TR" D ^%DT S X=Y
S DIC="^YSD(627.8,",DIC(0)="L",DLAYGO=627.8 D FILE^DICN S YSDA=+Y
D PATSTAT
S DIE="^YSD(627.8,",DA=YSDA,DR=".02////"_YSDFN_";.03///^S X=""NOW"";.04///^S X=YSDUZ;.05////"_DUZ_";66////"_YSSTAT_";65///^S X=X5"
L +^YSD(627.8,DA):9999
D ^DIE
L -^YSD(627.8,DA)
K DA,DIC,DIE,DR
D EN^YSGAFOBX(YSDA)
S YSTOUT=$D(DTOUT),YSUOUT=$O(Y(""))]"" I YSTOUT!YSUOUT S DIK="^YSD(627.8,",DA=YSDA D ^DIK Q
Q
GAFQ ;
;D RECORD^YSDX0001("GAF1^YSDX3B") ;Used for testing. Inactivated in YSDX0001...
S:'$D(YSGAF) G5=0 W !!,"Highest GAF past year: ",G5 W:$D(G11) " (dtd ",G11,")" W "// " R G7:DTIME S YSTOUT='$T,YSUOUT=G7["^" G:G7="" AX51 I YSTOUT!YSUOUT S YSQT=1 Q
I G7="??" S XQH="YS-GAF SCALE" D EN^XQH K X7 G GAFQ
I G7["?" D GAF2 K G7 G GAFQ
I G7>100!(G7<1)!(G7?.E1"."1N.N) D GAF3 K G7 G GAFQ
S %DT="AEX",X="N",%DT("A")="As of: " D ^%DT K %DT("A") S G8=$P(Y,"."),G9=(G8-1),YSOLD=G9_"."_$P(Y,".",2) D GAFUP
AX5 W !!,"Enter rating of current functioning as indicated on GAF Scale (100-1).",!,"Enter ""??"" for additional information on the GAF Scale.",!
Q
GAF2 ;
;D RECORD^YSDX0001("GAF2^YSDX3B") ;Used for testing. Inactivated in YSDX0001...
W !!,"Default shown is the highest recorded GAF Scale for this patient during ",!,"the past year. To change, enter a HIGHER number.",!,"Enter ""??"" for additional information on the GAF Scale.",! Q
GAF3 ;
W " ??",!,"Type a number (1-100) relevant to the GAF Scale." Q
GAFUP ;
;D RECORD^YSDX0001("GAFUP^YSDX3B") ;Used for testing. Inactivated in YSDX0001...
;S DIC="^YSD(627.8,",DIC(0)="L",X=YSOLD,DLAYGO=627 D ^DIC Q:Y'>0 S YSDA=+Y
K DD,DO,DA,DINUM
S X="NOW",%DT="TR" D ^%DT S X=Y
S DIC="^YSD(627.8,",DIC(0)="L",DLAYGO=627.8 D FILE^DICN S YSDA=+Y
D PATSTAT
S DIE="^YSD(627.8,",DA=YSDA,DR=".02////"_YSDFN_";.03///^S X=YSOLD;.04///^S X=YSDUZ;.05///^S X=""`""_DUZ;66////"_YSSTAT_";65///^S X=G7"
L +^YSD(627.8,DA):9999
D ^DIE
L -^YSD(627.8,DA)
K DA,DIC,DIE,DR
D EN^YSGAFOBX(YSDA)
Q
;
PATSTAT ;
K VAIP
S YSSTAT=""
D IN5^VADPT
S YSSTAT=VAIP(1)
I YSSTAT S YSSTAT="I" Q
S YSSTAT="O"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSDX3B 4821 printed Apr 09, 2024@21:22:17 Page 2
YSDX3B ;SLC/DJP-Entry of Axis 4 & Axis 5 Diagnoses for the Mental Health Medical Record ;8/29/89 08:51
+1 ;;5.01;MENTAL HEALTH;**33,43,49**;Dec 30, 1994
+2 ;D RECORD^YSDX0001("YSDX3B^YSDX3B") ;Used for testing. Inactivated in YSDX0001...
+3 ;
AXIS4 ; Called by routine YSCEN1, YSDX3
+1 ; Entry of Axis 4 information
+2 ;D RECORD^YSDX0001("AXIS4^YSDX3B") ;Used for testing. Inactivated in YSDX0001...
+3 WRITE !!,"AXIS 4",!,"------"
AX43 ;
+1 ;D RECORD^YSDX0001("AX43^YSDX3B") ;Used for testing. Inactivated in YSDX0001...
+2 WRITE !!,"Enter PSYCHOSOCIAL STRESSOR: "
READ X3:DTIME
SET YSTOUT='$TEST
SET YSUOUT=X3["^"
IF YSTOUT!YSUOUT
SET YSQT=1
QUIT
+3 if X3=""
QUIT
IF X3="?"
DO AX41
KILL X3
GOTO AX43
+4 IF X3["??"
SET XQH="YS-PSYCHOSOCIAL STRESSORS"
DO EN^XQH
KILL X3
GOTO AX43
+5 IF $LENGTH(X3)>60!($LENGTH(X3)<1)
DO AX41
KILL X3
GOTO AX43
AX42 ;
+1 ;D RECORD^YSDX0001("AX42^YSDX3B") ;Used for testing. Inactivated in YSDX0001...
+2 WRITE !,"Enter SEVERITY CODE: "
READ X4:DTIME
SET YSTOUT='$TEST
SET YSUOUT=X4["^"
IF YSTOUT!YSUOUT
SET YSQT=1
QUIT
+3 IF X4="??"
SET XQH="YS-AXIS 4"
DO EN^XQH
KILL X4
GOTO AX42
+4 IF X4'?1N!(X4<0)!(X4>6)
DO AX4
GOTO AX42
+5 SET X6=$SELECT(X4=1:"NONE",X4=2:"MILD",X4=3:"MODERATE",X4=4:"SEVERE",X4=5:"EXTREME",X4=6:"CATASTROPHIC",X4=0:"INADEQUATE INFORMATION OR NO CHANGE IN CONDITION",1:"")
WRITE " "_X6
+6 SET DIC="^YSD(627.8,"
SET DIC(0)="L"
SET X="""N"""
SET DLAYGO=627
+7 DO ^DIC
if Y'>0
QUIT
SET YSDA=+Y
+8 SET YSDUZ=$PIECE(^VA(200,DUZ,0),U)
SET DIE="^YSD(627.8,"
SET DA=YSDA
SET DR=".02////"_YSDFN_";.03///^S X=""NOW"";.04///^S X=YSDUZ;.05///^S X=""`""_DUZ;60//^S X=X3;61//^S X=X4"
+9 LOCK +^YSD(627.8,DA):9999
+10 KILL Y
+11 DO ^DIE
+12 LOCK -^YSD(627.8,DA)
+13 KILL DA,DIC,DIE,DR
+14 SET YSTOUT=$DATA(DTOUT)
IF YSTOUT!($ORDER(Y(""))]"")
SET DIK="^YSD(627.8,"
SET DA=YSDA
DO ^DIK
if YSTOUT
QUIT
GOTO AX43
AX4 ;
+1 ;D RECORD^YSDX0001("AX4^YSDX3B") ;Used for testing. Inactivated in YSDX0001...
+2 WRITE !!,"Enter code indicating overall severity of psychosocial stressor.",!
SET A1=$PIECE(^DD(627.8,61,0),U,3)
FOR I=1:1:8
SET A2=$PIECE(A1,";",I)
WRITE !?5,$PIECE(A2,":")_" "_$PIECE(A2,":",2)
+3 WRITE !!,"Enter ""??"" for additional information on Severity Codes."
+4 QUIT
AX41 ;
+1 ;D RECORD^YSDX0001("AX41^YSDX3B") ;Used for testing. Inactivated in YSDX0001...
+2 WRITE !!,"Enter short narrative (1-60 characters) describing source of stress."
+3 QUIT
AXIS5 ; Called by routines YSCEN1, YSDX3
+1 ;D RECORD^YSDX0001("AXIS5^YSDX3B") ;Used for testing. Inactivated in YSDX0001...
+2 ;Entry of Axis 5 information
+3 WRITE !!,"AXIS 5",!,"------",!
DO GAF^YSDX3UB
AX51 ;
+1 ;D RECORD^YSDX0001("AX51^YSDX3B") ;Used for testing. Inactivated in YSDX0001...
+2 WRITE !!,"Enter RATING OF CURRENT FUNCTIONING: "
READ X5:DTIME
SET YSTOUT='$TEST
SET YSUOUT=X5["^"
IF YSTOUT!YSUOUT
SET YSQT=1
QUIT
+3 if X5=""
QUIT
IF X5="?"
DO AX5
KILL X5
GOTO AX51
+4 IF X5["??"
SET XQH="YS-GAF SCALE"
DO EN^XQH
KILL X5
GOTO AX51
+5 IF X5>100!(X5<1)!(X5'?.N)
DO AX5
KILL X5
GOTO AX51
+6 KILL DD,DO,DA,DINUM
+7 SET X="NOW"
SET %DT="TR"
DO ^%DT
SET X=Y
+8 SET DIC="^YSD(627.8,"
SET DIC(0)="L"
SET DLAYGO=627.8
DO FILE^DICN
SET YSDA=+Y
+9 DO PATSTAT
+10 SET DIE="^YSD(627.8,"
SET DA=YSDA
SET DR=".02////"_YSDFN_";.03///^S X=""NOW"";.04///^S X=YSDUZ;.05////"_DUZ_";66////"_YSSTAT_";65///^S X=X5"
+11 LOCK +^YSD(627.8,DA):9999
+12 DO ^DIE
+13 LOCK -^YSD(627.8,DA)
+14 KILL DA,DIC,DIE,DR
+15 DO EN^YSGAFOBX(YSDA)
+16 SET YSTOUT=$DATA(DTOUT)
SET YSUOUT=$ORDER(Y(""))]""
IF YSTOUT!YSUOUT
SET DIK="^YSD(627.8,"
SET DA=YSDA
DO ^DIK
QUIT
+17 QUIT
GAFQ ;
+1 ;D RECORD^YSDX0001("GAF1^YSDX3B") ;Used for testing. Inactivated in YSDX0001...
+2 if '$DATA(YSGAF)
SET G5=0
WRITE !!,"Highest GAF past year: ",G5
if $DATA(G11)
WRITE " (dtd ",G11,")"
WRITE "// "
READ G7:DTIME
SET YSTOUT='$TEST
SET YSUOUT=G7["^"
if G7=""
GOTO AX51
IF YSTOUT!YSUOUT
SET YSQT=1
QUIT
+3 IF G7="??"
SET XQH="YS-GAF SCALE"
DO EN^XQH
KILL X7
GOTO GAFQ
+4 IF G7["?"
DO GAF2
KILL G7
GOTO GAFQ
+5 IF G7>100!(G7<1)!(G7?.E1"."1N.N)
DO GAF3
KILL G7
GOTO GAFQ
+6 SET %DT="AEX"
SET X="N"
SET %DT("A")="As of: "
DO ^%DT
KILL %DT("A")
SET G8=$PIECE(Y,".")
SET G9=(G8-1)
SET YSOLD=G9_"."_$PIECE(Y,".",2)
DO GAFUP
AX5 WRITE !!,"Enter rating of current functioning as indicated on GAF Scale (100-1).",!,"Enter ""??"" for additional information on the GAF Scale.",!
+1 QUIT
GAF2 ;
+1 ;D RECORD^YSDX0001("GAF2^YSDX3B") ;Used for testing. Inactivated in YSDX0001...
+2 WRITE !!,"Default shown is the highest recorded GAF Scale for this patient during ",!,"the past year. To change, enter a HIGHER number.",!,"Enter ""??"" for additional information on the GAF Scale.",!
QUIT
GAF3 ;
+1 WRITE " ??",!,"Type a number (1-100) relevant to the GAF Scale."
QUIT
GAFUP ;
+1 ;D RECORD^YSDX0001("GAFUP^YSDX3B") ;Used for testing. Inactivated in YSDX0001...
+2 ;S DIC="^YSD(627.8,",DIC(0)="L",X=YSOLD,DLAYGO=627 D ^DIC Q:Y'>0 S YSDA=+Y
+3 KILL DD,DO,DA,DINUM
+4 SET X="NOW"
SET %DT="TR"
DO ^%DT
SET X=Y
+5 SET DIC="^YSD(627.8,"
SET DIC(0)="L"
SET DLAYGO=627.8
DO FILE^DICN
SET YSDA=+Y
+6 DO PATSTAT
+7 SET DIE="^YSD(627.8,"
SET DA=YSDA
SET DR=".02////"_YSDFN_";.03///^S X=YSOLD;.04///^S X=YSDUZ;.05///^S X=""`""_DUZ;66////"_YSSTAT_";65///^S X=G7"
+8 LOCK +^YSD(627.8,DA):9999
+9 DO ^DIE
+10 LOCK -^YSD(627.8,DA)
+11 KILL DA,DIC,DIE,DR
+12 DO EN^YSGAFOBX(YSDA)
+13 QUIT
+14 ;
PATSTAT ;
+1 KILL VAIP
+2 SET YSSTAT=""
+3 DO IN5^VADPT
+4 SET YSSTAT=VAIP(1)
+5 IF YSSTAT
SET YSSTAT="I"
QUIT
+6 SET YSSTAT="O"
+7 QUIT
