37 lines
2.4 KiB
Mathematica
37 lines
2.4 KiB
Mathematica
YSDX3A ;SLC/DJP-Entry of Axis 3 Diagnosis for the Mental Health Medical Record ; 7/13/89 10:05 ;
|
|
;;5.01;MENTAL HEALTH;**33**;Dec 30, 1994
|
|
;D RECORD^YSDX0001("YSDX3A^YSDX3A") ;Used for testing. Inactivated in YSDX0001...
|
|
;
|
|
; Called from routines YSCEN1, YSDX3
|
|
AXIS3 ;
|
|
;D RECORD^YSDX0001("AXIS3^YSDX3A") ;Used for testing. Inactivated in YSDX0001...
|
|
K YSDXDA,YSDA,YSDTY,YSNO,P1 W @IOF,!!?10,"ENTRY OF DIAGNOSIS - Continued - ",$E(YSNM,1,25) S YSAX=3,YSDTY="A",P1=0 K P2 W !!,"ACTIVE ICD9 DIAGNOSES (Axis 3): ",! D LIST^YSDX3U G:$D(YSNO) QUES2
|
|
I '$D(YSDXN) W !!?3,"No active ICD9 diagnosis on file for ",YSNM,".",!
|
|
D INQ^YSDX3U Q:$D(YSQT)
|
|
QUES2 ;Subroutine presents questions for Axis 3
|
|
;D RECORD^YSDX0001("QUES2^YSDX3A") ;Used for testing. Inactivated in YSDX0001...
|
|
I '$D(^XUSEC("YSD",DUZ)) W !!,"You must hold correct security key to enter ICD9 diagnosis." Q
|
|
W !!,"Enter ICD9 DIAGNOSIS: " W:$D(YSALZ) "331.00// " R X2:DTIME S YSTOUT='$T,YSUOUT=X2["^" I YSTOUT!YSUOUT S YSQT=1 Q
|
|
I $D(YSALZ) S:X2="" X2="331.0"
|
|
Q:X2="" I X2?.N I X2<(P1+1) D ICDP^YSDX3UA G:'$D(YSY) QUES2 S:$D(S1) YSDXDA=$P(S1,";")
|
|
I '$D(YSY) S X2=$$UP^XLFSTR(X2) D ICDLK^YSDX3UA G:Y<0 QUES2
|
|
DUPLCK ;Checks for and displays possible duplicate entries
|
|
;D RECORD^YSDX0001("DUPLCK^YSDX3A") ;Used for testing. Inactivated in YSDX0001...
|
|
S:'$D(YSDXDA) YSDXDA=+Y S:'$D(S2) S2=+Y S W2="",W1=S2_";"_"ICD9(" F I=1:1 S W2=$O(^YSD(627.8,"AG","I",YSDFN,W1,W2)) Q:W2="" S YSDUPDA=W2 D DUPL^YSDX3UA
|
|
CORR ;
|
|
;D RECORD^YSDX0001("CORR^YSDX3A") ;Used for testing. Inactivated in YSDX0001...
|
|
S YSW=$P(^ICD9(YSDXDA,0),U),YSWN=$P(^(0),U,3)
|
|
S %=0 F Q:$G(%) W !!?10,YSW_" "_YSWN,!!,"Is this the ICD9 diagnosis you wish to select" S %=2 D
|
|
.D YN^DICN S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) I YSTOUT!YSUOUT Q
|
|
.I '% W !!,"""YES"" indicates the diagnosis entered applies to ",YSNM,"."
|
|
I %=2 K YSDXDA,X2,S2 G QUES2
|
|
Q:%=-1
|
|
FILE ;
|
|
;D RECORD^YSDX0001("FILE^YSDX3A") ;Used for testing. Inactivated in YSDX0001...
|
|
;S DIC="^YSD(627.8,",DIC(0)="L",X="""N""",DLAYGO=627 D ^DIC Q:Y'>0 S YSDA=+Y,YSDXDA=YSDXDA_";ICD9("
|
|
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 Q:Y'>0 S YSDA=+Y,YSDXDA=YSDXDA_";ICD9("
|
|
D FILE^YSDX3UA
|
|
K YSDXDA,YSDA,YSDTY,YSDXDA1,YSDXDT,YSDXN,YSDXNN,YSDXST,YSMOD,YSW,YSWN,YSALZ,YSY,F1,F2,F3,K1,K2,K3,K4,K5,K6,L2,L3,L4,L5,L7,P2,P3,P4,P5,S2,W1,W2,W3,W4,W5,W6,X,X2 G:'$D(YSPLIC) QUES2
|