source: FOIAVistA/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPST09.m@ 811

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

initial load of FOIAVistA 6/30/08 version

File size: 1.3 KB
Line 
1PPPST09 ;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 ;
9EN ; -- Main entry point
10 D DPT
11 QUIT
12 ;
13REINDX ; -- 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 ;
20DPT ; 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 ;
Note: See TracBrowser for help on using the repository browser.