[613] | 1 | ONCOPST3 ;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
|
---|
| 21 | ADDNEW ;
|
---|
| 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
|
---|