| 1 | YSDX3UA ;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 | ;
|
|---|
| 5 | DSMLK ; 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)
|
|---|
| 12 | LK1 ;
|
|---|
| 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 | ;
|
|---|
| 20 | DSMP ; 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 | ;
|
|---|
| 27 | ICDLK ; 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)
|
|---|
| 34 | ICD1 ;
|
|---|
| 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 | ;
|
|---|
| 41 | ICDP ; 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 | ;
|
|---|
| 46 | DXLS D DXLS^YSDX3UA0
|
|---|
| 47 | QUIT
|
|---|
| 48 | ;
|
|---|
| 49 | DXLSQ D DXLSQ^YSDX3UA0
|
|---|
| 50 | QUIT
|
|---|
| 51 | ;
|
|---|
| 52 | DUPL ; 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:"")
|
|---|
| 62 | DUPLP ;
|
|---|
| 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 | ;
|
|---|
| 71 | FILE ; 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 ;->
|
|---|
| 105 | FILEQ ;
|
|---|
| 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 | ;
|
|---|
| 114 | CHECK ;
|
|---|
| 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 | ;
|
|---|
| 119 | DELETE ; 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 | ;
|
|---|
| 126 | EOR ;YSDX3UA - Utilities for Diagnosis Entry in the MH Medical Record (cont.) ;4/16/92 11:17
|
|---|
