source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOPST3.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.1 KB
RevLine 
[613]1ONCOPST3 ;HIRMFO/RTK-DATA CONVERSION CONTINUED ;2/7/96
2 ;;2.11;ONCOLOGY;**1**;Feb 07, 1996
3 ;
4 ;Routine to add any new entries from ONCOLOGY CONTACT file to new
5 ;ACOS NUMBER file. Any entries with a "#" in COMMENTS field will
6 ;be added to the ACOS NUMBER file.
7 ;
8 K TMP S NEWIEN=0
9 S FIEN=$O(^ONCO(160.19,"B",999000,"")) I FIEN="" S NEWIEN=999000
10 I FIEN'="" S D=998999 F X=0:0 S D=$O(^ONCO(160.19,"B",D)) Q:D=999999 S TMP=D
11 I $G(TMP) S NEWIEN=TMP+1 ;if some already there TMP will be last one
12 F XCON=0:0 S XCON=$O(^ONCO(165,XCON)) Q:XCON'>"" D
13 .S NOTADD=0,NEWNUM=$P($G(^ONCO(165,XCON,0)),"^",4)
14 .Q:NEWNUM'="#"
15 .D ADDNEW I NOTADD=1 S ^TMP($J,"NOTADD",XCON)="" Q ; allow new entry into 160.19 FILE^DICN
16 .;NEWENTRY = 6 digit # of newly added entry into 160.19. IF NOTADD=0
17 .S $P(^ONCO(165,XCON,0),"^",4)="#"_NEWENTRY
18 .S NEWIEN=NEWIEN+1
19 .Q
20 Q
21ADDNEW ;
22 I NEWIEN'?6N!($E(NEWIEN,1,3)'=999) S NOTADD=1 Q
23 S HOSPNAME=$P($G(^ONCO(165,XCON,0)),"^",1)
24 K DD,DO S DIC="^ONCO(160.19,",DIC(0)="L",DIC("DR")=".02///^S X=HOSPNAME",X=NEWIEN D FILE^DICN
25 I Y=-1 S NOTADD=1 Q
26 S NEWENTRY=NEWIEN
27 Q
Note: See TracBrowser for help on using the repository browser.