source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSDX3A.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1YSDX3A ;SLC/DJP-Entry of Axis 3 Diagnosis for the Mental Health Medical Record ; 7/13/89 10:05 ;
2 ;;5.01;MENTAL HEALTH;**33**;Dec 30, 1994
3 ;D RECORD^YSDX0001("YSDX3A^YSDX3A") ;Used for testing. Inactivated in YSDX0001...
4 ;
5 ; Called from routines YSCEN1, YSDX3
6AXIS3 ;
7 ;D RECORD^YSDX0001("AXIS3^YSDX3A") ;Used for testing. Inactivated in YSDX0001...
8 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
9 I '$D(YSDXN) W !!?3,"No active ICD9 diagnosis on file for ",YSNM,".",!
10 D INQ^YSDX3U Q:$D(YSQT)
11QUES2 ;Subroutine presents questions for Axis 3
12 ;D RECORD^YSDX0001("QUES2^YSDX3A") ;Used for testing. Inactivated in YSDX0001...
13 I '$D(^XUSEC("YSD",DUZ)) W !!,"You must hold correct security key to enter ICD9 diagnosis." Q
14 W !!,"Enter ICD9 DIAGNOSIS: " W:$D(YSALZ) "331.00// " R X2:DTIME S YSTOUT='$T,YSUOUT=X2["^" I YSTOUT!YSUOUT S YSQT=1 Q
15 I $D(YSALZ) S:X2="" X2="331.0"
16 Q:X2="" I X2?.N I X2<(P1+1) D ICDP^YSDX3UA G:'$D(YSY) QUES2 S:$D(S1) YSDXDA=$P(S1,";")
17 I '$D(YSY) S X2=$$UP^XLFSTR(X2) D ICDLK^YSDX3UA G:Y<0 QUES2
18DUPLCK ;Checks for and displays possible duplicate entries
19 ;D RECORD^YSDX0001("DUPLCK^YSDX3A") ;Used for testing. Inactivated in YSDX0001...
20 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
21CORR ;
22 ;D RECORD^YSDX0001("CORR^YSDX3A") ;Used for testing. Inactivated in YSDX0001...
23 S YSW=$P(^ICD9(YSDXDA,0),U),YSWN=$P(^(0),U,3)
24 S %=0 F Q:$G(%) W !!?10,YSW_" "_YSWN,!!,"Is this the ICD9 diagnosis you wish to select" S %=2 D
25 .D YN^DICN S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) I YSTOUT!YSUOUT Q
26 .I '% W !!,"""YES"" indicates the diagnosis entered applies to ",YSNM,"."
27 I %=2 K YSDXDA,X2,S2 G QUES2
28 Q:%=-1
29FILE ;
30 ;D RECORD^YSDX0001("FILE^YSDX3A") ;Used for testing. Inactivated in YSDX0001...
31 ;S DIC="^YSD(627.8,",DIC(0)="L",X="""N""",DLAYGO=627 D ^DIC Q:Y'>0 S YSDA=+Y,YSDXDA=YSDXDA_";ICD9("
32 K DD,DO,DA,DINUM
33 S X="NOW",%DT="TR" D ^%DT S X=Y
34 S DIC="^YSD(627.8,",DIC(0)="L",DLAYGO=627.8 D FILE^DICN Q:Y'>0 S YSDA=+Y,YSDXDA=YSDXDA_";ICD9("
35 D FILE^YSDX3UA
36 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
Note: See TracBrowser for help on using the repository browser.