source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCPOS03.m@ 1389

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

initial load of WorldVistAEHR

File size: 801 bytes
RevLine 
[613]1MCPOS03 ;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
Note: See TracBrowser for help on using the repository browser.