| [613] | 1 | PPPVPPIN ;ALB/JFP - Pre-init code for PPP ; 01 MAR 94
|
|---|
| 2 | ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;;APR 7,1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; This routine removes old cross refernnces
|
|---|
| 6 | EN ;
|
|---|
| 7 | D DELX
|
|---|
| 8 | W !!,">>> The PPP cross reference will be added in a partial init of the"
|
|---|
| 9 | W !," VAQ - TRANSACTION file on field .02 (Current Status)."
|
|---|
| 10 | W !!,"Done",!
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | DELX ; -- Deletes A1AY and A1AY2 cross reference
|
|---|
| 14 | N DA,DIK
|
|---|
| 15 | W !!,">>> Removing 'A1AY' cross reference from VAQ TRANSACTION file."
|
|---|
| 16 | S DA=0
|
|---|
| 17 | F S DA=$O(^DD(394.61,50,1,DA)) Q:DA<1 D
|
|---|
| 18 | .; -- naked set at DELX+4
|
|---|
| 19 | .I $G(^(DA,0))="394.61^A1AY^MUMPS" D
|
|---|
| 20 | ..S DIK="^DD(394.61,50,1,",DA(1)=50,DA(2)=394.61 D ^DIK
|
|---|
| 21 | ..W "... Done"
|
|---|
| 22 | ;
|
|---|
| 23 | W !!,">>> Removing 'A1AY2' cross reference from VAQ TRANSACTION file."
|
|---|
| 24 | S DA=0
|
|---|
| 25 | F S DA=$O(^DD(394.618,.01,1,DA)) Q:DA<1 D
|
|---|
| 26 | .; -- naked set at DELX+11
|
|---|
| 27 | .I $G(^(DA,0))="394.618^A1AY2^MUMPS" D
|
|---|
| 28 | ..S DIK="^DD(394.618,.01,1,",DA(1)=.01,DA(2)=394.618 D ^DIK
|
|---|
| 29 | ..W "... Done"
|
|---|
| 30 | ;
|
|---|
| 31 | QUIT
|
|---|
| 32 | ;
|
|---|
