| 1 | MCPOS03 ;HIRMFO/DAD-INSTRUMENT FLAT-->MULT CONVERSION FILE #699 ;5/31/96 13:36
|
---|
| 2 | ;;2.3;Medicine;;09/13/1996
|
---|
| 3 | ;
|
---|
| 4 | N D0,DA,DD,DIC,DINUM,DLAYGO,DO,MCARCODE,MCD0,MCDATA,MCINSTR
|
---|
| 5 | S MCDATA(1)=""
|
---|
| 6 | S MCDATA(2)="Moving instrument from flat field into multiple"
|
---|
| 7 | S MCDATA(3)="in the Endoscopy/Consult file (#699)."
|
---|
| 8 | D MES^XPDUTL(.MCDATA)
|
---|
| 9 | ;
|
---|
| 10 | S MCD0=0
|
---|
| 11 | F S MCD0=$O(^MCAR(699,MCD0)) Q:MCD0'>0 D
|
---|
| 12 | . S MCINSTR=+$P($G(^MCAR(699,MCD0,0)),U,7)
|
---|
| 13 | . I MCINSTR'>0 Q
|
---|
| 14 | . S $P(^MCAR(699,MCD0,0),U,7)=""
|
---|
| 15 | . I $O(^MCAR(699,MCD0,34,"B",MCINSTR,0)) Q
|
---|
| 16 | . S MCINSTR(0)=$G(^MCAR(699.48,MCINSTR,0))
|
---|
| 17 | . I $P(MCINSTR(0),U)="" Q
|
---|
| 18 | . K DD,DIC,DINUM,DO
|
---|
| 19 | . S DIC="^MCAR(699,"_MCD0_",34,",DIC(0)="M",DLAYGO=699
|
---|
| 20 | . S DIC("P")=$$GET1^DID(699,4,"","SPECIFIER")
|
---|
| 21 | . S (D0,DA(1))=MCD0,X=MCINSTR,MCARCODE=$P(MCINSTR(0),U,2)
|
---|
| 22 | . D FILE^DICN
|
---|
| 23 | . Q
|
---|
| 24 | Q
|
---|