| 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
 | 
|---|