source: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECDSREF.m@ 1073

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1ECDSREF ;BIR/MAM/RHK,JPW-DSS MUMPS Cross References ;6 May 95
2 ;;2.0; EVENT CAPTURE ;;8 May 96
3INACT ; kill 'AP' x-ref for inactivated code
4 S ECK=$P(^ECJ(DA,0),"^"),ECLOC=$P(ECK,"-"),ECUNIT=$P(ECK,"-",2),ECCAT=$P(ECK,"-",3),ECPRO=$P(ECK,"-",4)
5 K ^ECJ("AP",ECLOC,ECUNIT,ECCAT,ECPRO,DA),^ECJ("APP",ECLOC,ECUNIT,ECPRO,DA)
6 K ECK,ECCAT,ECLOC,ECPRO,ECUNIT
7 Q
8ACTIV ; set 'AP' x-ref when re-activated
9 Q:$D(ECCH) S ECK=$P(^ECJ(DA,0),"^"),ECLOC=$P(ECK,"-"),ECUNIT=$P(ECK,"-",2),ECCAT=$P(ECK,"-",3),ECPRO=$P(ECK,"-",4)
10 S ^ECJ("AP",ECLOC,ECUNIT,ECCAT,ECPRO,DA)="",^ECJ("APP",ECLOC,ECUNIT,ECPRO,DA)=""
11 K ECK,ECCAT,ECLOC,ECPRO,ECUNIT
12 Q
13AC ; set 'AC' x-ref on CATEGORY (Y/N) field in file 720
14 I X=1 S ^ECP("AC",$P(^ECP(DA,0),"^"),DA)=""
15 Q
16KILLAC ; kill 'AC' x-ref on CATEGORY (Y/N) field in file 720
17 K ^ECP("AC",$P(^ECP(DA,0),"^"),DA)
18 Q
19AP ; set 'AP' x-ref on EVENT CODE field in file 720.3
20 Q:$D(ECCH) S ECK=$P(^ECJ(DA,0),"^",1),ECLOC=$P(ECK,"-",1),ECUNIT=$P(ECK,"-",2),ECCAT=$P(ECK,"-",3),ECPRO=$P(ECK,"-",4)
21 S ^ECJ("AP",ECLOC,ECUNIT,ECCAT,ECPRO,DA)="",^ECJ("APP",ECLOC,ECUNIT,ECPRO,DA)=""
22 K ECLOC,ECUNIT,ECCAT,ECPRO,ECK
23 Q
24KILLAP ; kill 'AP' x-ref on EVENT CODE field in file 720.3
25 S ECK=$P(^ECJ(DA,0),"^",1),ECLOC=$P(ECK,"-",1),ECUNIT=$P(ECK,"-",2),ECCAT=$P(ECK,"-",3),ECPRO=$P(ECK,"-",4)
26 K ^ECJ("AP",ECLOC,ECUNIT,ECCAT,ECPRO,DA),^ECJ("APP",ECLOC,ECUNIT,ECPRO,DA),ECLOC,ECCAT,ECPRO,ECUNIT,ECK
27 Q
28ACC ; set 'ACC' x-ref on COST CENTER field in file 49
29 S ^DIC(49,"ACC",+X,DA)=""
30 Q
31KILLACC ; kill 'ACC' x-ref on COST CENTER field in file 49
32 K ^DIC(49,"ACC",+X,DA)
33 Q
34AST ; set AST cross reference on .01 field of 720.3
35 S ECLOC=$P($P(^ECJ(DA,0),"^"),"-"),^ECJ("AST",ECLOC,DA)="" K ECLOC Q
36 ;
37KAST ; kill AST cross reference on.01 field of 702.3
38 S ECLOC=$P($P(^ECJ(DA,0),"^"),"-") K ^ECJ("AST",ECLOC,DA),ECLOC Q
39 ;
40QUIT R !,"Enter ^ to quit or return to continue : ",ECZ:DTIME W ! I '$T!(ECZ["^") S ECQT=1
41 Q
Note: See TracBrowser for help on using the repository browser.