64 lines
3.0 KiB
Mathematica
64 lines
3.0 KiB
Mathematica
YSDX3RUA ;SLC/DJP-Print Utilities for Diagnoses Reporting in MH - Continued ;12/14/93 09:17
|
|
;;5.01;MENTAL HEALTH;**16**;Dec 30, 1994
|
|
;D RECORD^YSDX0001("^YSDX3RUA") ;Used for testing. Inactivated in YSDX0001...
|
|
;
|
|
AX4 ; Called by routine YSDX3R
|
|
; Print latest Axis 4 information
|
|
;D RECORD^YSDX0001("AX4^YSDX3RUA") ;Used for testing. Inactivated in YSDX0001...
|
|
Q:'$D(^YSD(627.8,"AX4",YSDFN)) S A1=0 F I=1:1:1 S A1=$O(^YSD(627.8,"AX4",YSDFN,A1)) Q:'A1 S A2=0 F S A2=$O(^YSD(627.8,"AX4",YSDFN,A1,A2)) Q:'A2 D AX4P
|
|
Q
|
|
AX4P ;
|
|
;D RECORD^YSDX0001("AX4P^YSDX3RUA") ;Used for testing. Inactivated in YSDX0001...
|
|
S YSPS=$P($G(^YSD(627.8,A2,60)),U) S:YSPS']"" YSPS="None given" S A3=$P(^(60),U,2),Y=$P(^(0),U,3) D DD^%DT S A9=$P(Y,"@")
|
|
S TOTSET=";"_$P(^DD(627.8,61,0),U,3),SUBSET=$F(TOTSET,";"_A3_":") I SUBSET S YSAX4=$E($P($E(TOTSET,SUBSET,999),";"),1,50) I $Y+YSSL+4>IOSL D CK^YSDX3RU Q:YSTOUT!YSUOUT!YSLFT
|
|
W !!,"AXIS IV: Psychosocial stressors: ",YSPS,!?10,"Severity: ",A3_"--"_YSAX4,!?10,"Dated: ",A9
|
|
Q
|
|
AX5 ; Called by routine YSSP6
|
|
;
|
|
;D RECORD^YSDX0001("AX5^YSDX3RUA") ;Used for testing. Inactivated in YSDX0001...
|
|
Q:'$D(^YSD(627.8,"AX5",YSDFN)) S A5=$O(^YSD(627.8,"AX5",YSDFN,0)) Q:'A5 S A6=$O(^YSD(627.8,"AX5",YSDFN,A5,0)) Q:'A6 S A7=$P(^YSD(627.8,A6,60),U,3) D GAF^YSDX3UB
|
|
S Y=$P(^YSD(627.8,A6,0),U,3) D DD^%DT S A8=$P(Y,"@")
|
|
I $Y+YSSL+4>IOSL D CK^YSDX3RU Q:YSTOUT!YSUOUT!YSLFT
|
|
W !!,"AXIS V: Current GAF: ",A7_" (as of "_A8_")",!?10,"Highest GAF past year: ",$S($D(G5):G5,1:"No other GAF for past year") I $D(G5) W " (dtd "_$S($D(G11):G11,1:"Date Missing")_")",!
|
|
D FINISH^YSDX3RU
|
|
QUIT
|
|
;
|
|
DXLS ; Called by routines YSDX3R, YSPP6
|
|
; This subroutine looks up and displays the diagnosis for Length of Stay (DXLS)
|
|
;D RECORD^YSDX0001("DXLS^YSDX3RUA") ;Used for testing. Inactivated in YSDX0001...
|
|
Q:'$D(^YSD(627.8,"AD",YSDFN))
|
|
S J=$O(^YSD(627.8,"AD",YSDFN,0)) ; Inverse date
|
|
DXLS1 ;
|
|
;D RECORD^YSDX0001("DXLS1^YSDX3RUA") ;Used for testing. Inactivated in YSDX0001...
|
|
S J1=$O(^YSD(627.8,"AD",YSDFN,J,0)) ; IEN
|
|
S J2=$P(^YSD(627.8,+J1,1),U) ; Diag variable pointer
|
|
S Y=$P(^YSD(627.8,+J1,0),U,3) D DD^%DT S YSDXLSD=Y ; Diag Date/time
|
|
S J3=$P(J2,";",2) ; Global ref
|
|
S J4=+$P(J2,";") ; IEN
|
|
S J5="^"_J3_J4_","_0_")" ; Global ref of 0 node
|
|
S J50=@J5 ; Data for 0 node
|
|
;
|
|
; DSM?
|
|
I J3["YSD" D
|
|
. S YSDXLSN=^YSD(627.7,+J4,"D") ; Diagnosis name
|
|
. S YSDXLS=$P(J50,U,2) ; ICD9 #
|
|
;
|
|
; ICD9?
|
|
I J3["ICD9(" D
|
|
. S YSDXLSN=$P(J50,U,3) ; Diagnosis name
|
|
. S YSDXLS=$P(J50,U) ; ICD9 #
|
|
;
|
|
I $D(YSDXLS) D
|
|
. W !!,"Principal Diagnosis (DXLS): ",!!?3
|
|
. W YSDXLS_" "_$E(YSDXLSN,1,25),!?8," dated ",YSDXLSD
|
|
;
|
|
; Modifiers?
|
|
I $D(^YSD(627.8,+J1,5)) D
|
|
. S J6=$P(^YSD(627.8,+J1,5,0),U,3) ; Stands for
|
|
. F I=1:1:J6 W !?3,"--- ",$P(^YSD(627.8,+J1,5,I,0),U,3)
|
|
;
|
|
K J1,J2,J3,J4,J5,J50,J6,YSDXLSN,YSDXLS,YSDXLSD,YSCON
|
|
QUIT
|
|
;
|
|
EOR ;YSDX3RUA - Print Utilities for Diagnoses reporting - continued ;9/18/92 15:37
|