1 | MCPOS04A ;HIRMFO/DAD-CONSULT CONVERSION 699 >>>===> 699.5 ;7/5/96 08:35
|
---|
2 | ;;2.3;Medicine;;09/13/1996
|
---|
3 | ;
|
---|
4 | ; WORD PROCESSING FIELDS
|
---|
5 | S %X="^MCAR(699,"_MC699D0_",20,",%Y="^MCAR(699.5,"_MC6995D0_",20,"
|
---|
6 | D %XY^%RCR ; SUBJECTIVE WP
|
---|
7 | S %X="^MCAR(699,"_MC699D0_",21,",%Y="^MCAR(699.5,"_MC6995D0_",21,"
|
---|
8 | D %XY^%RCR ; OBJECTIVE WP
|
---|
9 | S %X="^MCAR(699,"_MC699D0_",22,",%Y="^MCAR(699.5,"_MC6995D0_",22,"
|
---|
10 | D %XY^%RCR ; ASSESSMENT WP
|
---|
11 | S %X="^MCAR(699,"_MC699D0_",23,",%Y="^MCAR(699.5,"_MC6995D0_",35,"
|
---|
12 | D %XY^%RCR ; PLANNED WP
|
---|
13 | ;
|
---|
14 | ; MEDICATIONS
|
---|
15 | S MC699D1=0
|
---|
16 | F S MC699D1=$O(^MCAR(699,MC699D0,8,MC699D1)) Q:MC699D1'>0 D
|
---|
17 | . S MCDATA=+$P($G(^MCAR(699,MC699D0,8,MC699D1,0)),U)
|
---|
18 | . I $O(^MCAR(699.5,MC6995D0,4,"B",MCDATA,0)) Q
|
---|
19 | . I $P($G(^PSDRUG(MCDATA,0)),U)="" Q
|
---|
20 | . K DD,DIC,DINUM,DO
|
---|
21 | . S DIC="^MCAR(699.5,"_MC6995D0_",4,",DIC(0)="L"
|
---|
22 | . S DIC("P")=$$GET1^DID(699.5,5,"","SPECIFIER"),DLAYGO=699.5
|
---|
23 | . S (D0,DA(1))=MC6995D0,X=MCDATA D FILE^DICN
|
---|
24 | . Q
|
---|
25 | ;
|
---|
26 | ; TECHNIQUE
|
---|
27 | S MC699D1=0
|
---|
28 | F S MC699D1=$O(^MCAR(699,MC699D0,2,MC699D1)) Q:MC699D1'>0 D
|
---|
29 | . S MCDATA=+$P($G(^MCAR(699,MC699D0,2,MC699D1,0)),U)
|
---|
30 | . I $O(^MCAR(699.5,MC6995D0,2,"B",MCDATA,0)) Q
|
---|
31 | . I $P($G(^MCAR(699.6,MCDATA,0)),U)="" Q
|
---|
32 | . K DD,DIC,DINUM,DO
|
---|
33 | . S DIC="^MCAR(699.5,"_MC6995D0_",2,",DIC(0)="L"
|
---|
34 | . S DIC("P")=$$GET1^DID(699.5,7,"","SPECIFIER"),DLAYGO=699.5
|
---|
35 | . S (D0,DA(1))=MC6995D0,X=MCDATA D FILE^DICN
|
---|
36 | . Q
|
---|
37 | ;
|
---|
38 | ; COMPLICATIONS
|
---|
39 | S MC699D1=0
|
---|
40 | F S MC699D1=$O(^MCAR(699,MC699D0,17,MC699D1)) Q:MC699D1'>0 D
|
---|
41 | . S MCDATA=+$P($G(^MCAR(699,MC699D0,17,MC699D1,0)),U)
|
---|
42 | . I $O(^MCAR(699.5,MC6995D0,3,"B",MCDATA,0)) Q
|
---|
43 | . I $P($G(^MCAR(696.9,MCDATA,0)),U)="" Q
|
---|
44 | . K DD,DIC,DINUM,DO
|
---|
45 | . S DIC="^MCAR(699.5,"_MC6995D0_",3,",DIC(0)="L"
|
---|
46 | . S DIC("P")=$$GET1^DID(699.5,3,"","SPECIFIER"),DLAYGO=699.5
|
---|
47 | . S (D0,DA(1))=MC6995D0,X=MCDATA D FILE^DICN
|
---|
48 | . Q
|
---|
49 | ;
|
---|
50 | ; ICD DIAGNOSIS
|
---|
51 | S MC699D1=0
|
---|
52 | F S MC699D1=$O(^MCAR(699,MC699D0,"ICD",MC699D1)) Q:MC699D1'>0 D
|
---|
53 | . S MCDATA=$G(^MCAR(699,MC699D0,"ICD",MC699D1,0))
|
---|
54 | . S MCNARRDX=$P(MCDATA,U,2)
|
---|
55 | . I $O(^MCAR(699.5,MC6995D0,"ICD","B",+$P(MCDATA,U),0)) Q
|
---|
56 | . I $P($G(^ICD9(+$P(MCDATA,U),0)),U)="" Q
|
---|
57 | . K DD,DIC,DINUM,DO
|
---|
58 | . S DIC="^MCAR(699.5,"_MC6995D0_",""ICD"",",DIC(0)="L"
|
---|
59 | . S DIC("P")=$$GET1^DID(699.5,700,"","SPECIFIER"),DLAYGO=699.5
|
---|
60 | . I MCNARRDX]"" S DIC("DR")=".02///^S X=$E(MCNARRDX,1,80)"
|
---|
61 | . S (D0,DA(1))=MC6995D0,X=+$P(MCDATA,U) D FILE^DICN K MCNARRDX
|
---|
62 | . Q
|
---|
63 | ;
|
---|
64 | ; IMAGE
|
---|
65 | S MC699D1=0
|
---|
66 | F S MC699D1=$O(^MCAR(699,MC699D0,2005,MC699D1)) Q:MC699D1'>0 D
|
---|
67 | . S MCDATA=+$P($G(^MCAR(699,MC699D0,2005,MC699D1,0)),U)
|
---|
68 | . I $O(^MCAR(699.5,MC6995D0,2005,"B",MCDATA,0)) Q
|
---|
69 | . I $P($G(^MAG(2005,MCDATA,0)),U)="" Q
|
---|
70 | . K DD,DIC,DINUM,DO
|
---|
71 | . S DIC="^MCAR(699.5,"_MC6995D0_",2005,",DIC(0)="L"
|
---|
72 | . S DIC("P")=$$GET1^DID(699.5,2005,"","SPECIFIER"),DLAYGO=699.5
|
---|
73 | . S (D0,DA(1))=MC6995D0,X=MCDATA D FILE^DICN
|
---|
74 | . Q
|
---|
75 | Q
|
---|