| [613] | 1 | PPPST09 ;ALB/JFP - PPP, SET TRIGGER IN FOREIGN FILE;01MAR94
|
|---|
| 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 re set the SET/KILL logic for the cross reference
|
|---|
| 6 | ; in file 2, field .09 (SSN). This code has been approved by the
|
|---|
| 7 | ; SAC.
|
|---|
| 8 | ;
|
|---|
| 9 | EN ; -- Main entry point
|
|---|
| 10 | D DPT
|
|---|
| 11 | QUIT
|
|---|
| 12 | ;
|
|---|
| 13 | REINDX ; -- Re-index new cross reference
|
|---|
| 14 | S DIK="^DD("_DA(2)_","_DA(1)_",1," D IX1^DIK
|
|---|
| 15 | ;
|
|---|
| 16 | W !,?3,"- Cross-reference added to field ",DA(1)," (",$P(^DD(DA(2),DA(1),0),"^",1),") of file ",DA(2)
|
|---|
| 17 | ;
|
|---|
| 18 | QUIT
|
|---|
| 19 | ;
|
|---|
| 20 | DPT ; Changes call in SET/KILL statement of cross reference from A1AY to PPP
|
|---|
| 21 | ;
|
|---|
| 22 | N DA,DIE,DR,PPPFND
|
|---|
| 23 | ;
|
|---|
| 24 | S DA=0,PPPFND=0
|
|---|
| 25 | F S DA=$O(^DD(2,.09,1,DA)) Q:DA<1 D
|
|---|
| 26 | .I $G(^(DA,0))="2^AD^MUMPS" D
|
|---|
| 27 | ..S PPPFND=1
|
|---|
| 28 | ..W !!,">>> Changing Set statement in AD Xref of ^DPT, field SSN to call PPPFMX"
|
|---|
| 29 | ..S DIE="^DD(2,.09,1,",DA(1)=1
|
|---|
| 30 | ..S DR="1///S PPP=X,X=""PPPFMX"" X ^%ZOSF(""TEST"") D:$T SNSSN^PPPFMX S X=PPP K PPP"
|
|---|
| 31 | ..D ^DIE
|
|---|
| 32 | ..W "...Done"
|
|---|
| 33 | ..;
|
|---|
| 34 | ..W !!,">>> Changing Kill statement in AD Xref of ^DPT, field SSN to call PPPFMX"
|
|---|
| 35 | ..S DIE="^DD(2,.09,1,",DA(1)=1
|
|---|
| 36 | ..S DR="2///S PPP=X,X=""PPPFMX"" X ^%ZOSF(""TEST"") D:$T KNSSN^PPPFMX S X=PPP K PPP"
|
|---|
| 37 | ..D ^DIE
|
|---|
| 38 | ..W "...Done"
|
|---|
| 39 | I 'PPPFND D
|
|---|
| 40 | .W !!,"Error... AD Xref of ^DPT, field SSN is required"
|
|---|
| 41 | .W !,"Call ISC SUPPORT for assistance"
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
