source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSDX3UA.m@ 1375

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

initial load of WorldVistAEHR
File size: 4.3 KB
Line 
1YSDX3UA ;SLC/DJP/LJA-Utilities for Diagnosis Entry in the MH Medical Record (cont.) ;12/14/93 13:02
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;D RECORD^YSDX0001("^YSDX3UA") ;Used for testing. Inactivated in YSDX0001...
4 ;
5DSMLK ; Called by routine YSDX3
6 ; Keywork lookup for DSM
7 ;D RECORD^YSDX0001("DSMLK^YSDX3UA") ;Used for testing. Inactivated in YSDX0001...
8 S X=$P(X1," ") G:$P(X1," ",2)="" LK1
9 S Q=$C(34),D="S A=^(1) I "
10 F I=2:1 S B=$P(X1," ",I) Q:B="" S:B'[Q D=D_"(A["" "_B_""")&"
11 S DIC("S")=$E(D,1,$L(D)-1)
12LK1 ;
13 ;D RECORD^YSDX0001("LK1^YSDX3UA") ;Used for testing. Inactivated in YSDX0001...
14 S DIC("S")="I $P(^(0),U,2)=4" ;Allow DSM-IV selection only...
15 S DIC(0)="QMZE",DIC="^YSD(627.7,"
16 D ^DIC
17 K DIC("S")
18 QUIT
19 ;
20DSMP ; Called by routine YSDX3
21 ;D RECORD^YSDX0001("DSMP^YSDX3UA") ;Used for testing. Inactivated in YSDX0001...
22 I '$D(P2) W " ?? " W @IOF G AGAIN^YSDX3
23 S S1=$P(^YSD(627.8,P2(X1),1),U),S2=$P(S1,";"),YSY=1
24 QUIT
25 ;
26 ;
27ICDLK ; Called from YSDX3A
28 ; Lookup on the ICD9 File
29 ;D RECORD^YSDX0001("ICDLK^YSDX3UA") ;Used for testing. Inactivated in YSDX0001...
30 S X=$P(X2," ") G:$P(X2," ",2)="" ICD1
31 S Q=$C(34),D="S A=$C(32)_^(1) I "
32 F I=2:1 S B=$P(X2," ",I) Q:B="" S:B'[Q D=D_"(A["" "_B_""")&"
33 S DIC("S")=$E(D,1,$L(D)-1)
34ICD1 ;
35 ;D RECORD^YSDX0001("ICD1^YSDX3UA") ;Used for testing. Inactivated in YSDX0001...
36 S X=X2,DIC(0)="QMZE",DIC="^ICD9("
37 D ^DIC
38 K DIC("S")
39 QUIT
40 ;
41ICDP ; Called by routine YSDX3A
42 ;D RECORD^YSDX0001("ICDP^YSDX3UA") ;Used for testing. Inactivated in YSDX0001...
43 S S1=$P(^YSD(627.8,P2(X2),1),U),S2=^ICD9($P(S1,";"),0),YSY=1
44 QUIT
45 ;
46DXLS D DXLS^YSDX3UA0
47 QUIT
48 ;
49DXLSQ D DXLSQ^YSDX3UA0
50 QUIT
51 ;
52DUPL ; Called by routine YSDX3, YSDX3A
53 ; Print out information concerning duplicate entry
54 ;D RECORD^YSDX0001("DUPL^YSDX3UA") ;Used for testing. Inactivated in YSDX0001...
55 S W3=$P(^VA(200,$P(^YSD(627.8,W2,0),U,4),0),U)
56 S Y=$P(^YSD(627.8,W2,0),U,3) D DD^%DT S W4=Y
57 I YSAX=1 S YSDXND=$P(^YSD(627.7,S2,0),U),YSDXD=$P(^(0),U)
58 I YSAX=3 S YSDXND=$P(^ICD9(S2,0),U,3),YSDXD=$P(^(0),U)
59 S W5=$P(^YSD(627.8,W2,1),U,2)
60 I W5="i" K YSDXND,YSDXD,W3,W4,W5 QUIT ;->
61 S W6=$S(W5="v":"VERIFIED",W5="p":"PROVISIONAL",W5="i":"INACTIVE",W5="r":"REFORMULATED",W5="n":"NOT FOUND",W5="ru":"RULE OUT",1:"")
62DUPLP ;
63 ;D RECORD^YSDX0001("DUPLP^YSDX3UA") ;Used for testing. Inactivated in YSDX0001...
64 I '$D(YSF1) D
65 . W !!,"This diagnosis has been entered as follows: "
66 . W !!?5,"DIAGNOSIS: ",?15,YSDXND_" "_YSDXD,!?5,"STATUS:"
67 . W ?13,W6,!?5,"BY:",?13,$E(W3,1,25)_" on "_W4,!
68 S YSF1=1
69 QUIT
70 ;
71FILE ; Called from routines YSDX3, YSDX3A
72 ;D RECORD^YSDX0001("FILE^YSDX3UA") ;Used for testing. Inactivated in YSDX0001...
73 S YSDUZ=$P(^VA(200,DUZ,0),U)
74 W !
75 S DIE=DIC,DA=YSDA,DR=".02////"_YSDFN_";.03//NOW;.04//"_YSDUZ_";.05///^S X=""`""_DUZ;1////^S X=YSDXDA;5"
76 L +@(DIE_"DA)")
77 D ^DIE
78 L -@(DIE_"DA)")
79 S YSTOUT=$D(DTOUT) I YSTOUT D DELETE QUIT ;->
80 D CHECK QUIT:YSUOUT ;->
81 S C1=$P(^YSD(627.8,YSDA,1),U,2)
82 I C1="" W !!?18,"Incomplete information." D DELETE QUIT ;->
83 S C2=$S(C1="v":"A",C1="p":"A",C1="i":"I",C1="r":"I",C1="n":"I",C1="ru":"A",1:"I")
84 S DIE="^YSD(627.8,",DA=YSDA,DR="7///^S X=C2;8///NOW"
85 L +^YSD(627.8,DA)
86 D ^DIE
87 L -^YSD(627.8,DA)
88 K DIE
89 S YSTOUT=$D(DTOUT) I YSTOUT QUIT ;->
90 D CHECK QUIT:YSUOUT ;->
91 I $D(W3) D
92 . S DIE="^YSD(627.8,",DA=YSDUPDA
93 . S DR="7///^S X=""I"";8///NOW;9///^S X=""Y"""
94 . L +^YSD(627.8,DA)
95 . D ^DIE
96 . L -^YSD(627.8,DA)
97 D DXLS,DXLSQ
98 S DIE="^YSD(627.8,",DA=YSDA
99 S DR="10///^S X=YSDXLX;80"
100 L +^YSD(627.8,DA)
101 D ^DIE
102 L -^YSD(627.8,DA)
103 S YSTOUT=$D(DTOUT) QUIT:YSTOUT ;->
104 D CHECK QUIT:YSUOUT ;->
105FILEQ ;
106 ;D RECORD^YSDX0001("FILEQ^YSDX3UA") ;Used for testing. Inactivated in YSDX0001...
107 S %=0
108 F Q:$G(%) W !!," Do you want to record this diagnosis" S %=1 D
109 . D YN^DICN
110 . I '% W !!,"NO will delete this entry. YES will file it under the patient's name."
111 I %=2!(%=-1) D DELETE
112 QUIT
113 ;
114CHECK ;
115 ;D RECORD^YSDX0001("CHECK^YSDX3UA") ;Used for testing. Inactivated in YSDX0001...
116 S YSUOUT=$O(Y(""))]"" I 'YSUOUT QUIT ;->
117 W !!?18,"Incomplete information."
118 ;
119DELETE ; Called by routine YSDX3UB
120 ;D RECORD^YSDX0001("DELETE^YSDX3UA") ;Used for testing. Inactivated in YSDX0001...
121 S DIK="^YSD(627.8,",DA=YSDA
122 D ^DIK
123 W !!?15,"< This diagnosis deleted. >"
124 QUIT
125 ;
126EOR ;YSDX3UA - Utilities for Diagnosis Entry in the MH Medical Record (cont.) ;4/16/92 11:17
Note: See TracBrowser for help on using the repository browser.