source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCOREX.m@ 1361

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

initial load of WorldVistAEHR

File size: 1.8 KB
RevLine 
[613]1MCOREX ;WISC/TJK-OERR/MEDICINE DATA EXTRACT UTILITY ;2/17/98 14:48
2 ;;2.3;Medicine;**17**;09/13/1996
3SET S MCK=MCK+1,^TMP("MC",$J,MCC,MCK)=MCM_U_MCHEAD Q
4POINT Q:'$D(^MCAR(MCFILE,MCARGDA,MCNODE))
5 S MCM=$P($G(^MCAR(MCFILE,MCARGDA,MCNODE)),U,MCPIECE)
6 Q:'MCM S MCM=$P($G(^MCAR(MCFILE1,MCM,0)),U) Q:MCM=""
7 D SET
8 Q
9MPOINT Q:'$D(^MCAR(MCFILE,MCARGDA,MCNODE))
10 F I=0:0 S I=$O(^MCAR(MCFILE,MCARGDA,MCNODE,I)) Q:I'?1N.N D
11 .S J=$P(^MCAR(MCFILE,MCARGDA,MCNODE,I,0),U,MCPIECE)
12 .Q:'J S MCM=$P($G(^MCAR(MCFILE1,J,0)),U)
13 .Q:MCM="" D SET
14 Q
15FREE Q:'$D(^MCAR(MCFILE,MCARGDA,MCNODE))
16 S MCM=$P(^MCAR(MCFILE,MCARGDA,MCNODE),U,MCPIECE) D SET Q
17MFREE Q:'$D(^MCAR(MCFILE,MCARGDA,MCNODE))
18 F I=0:0 S I=$O(^MCAR(MCFILE,MCARGDA,MCNODE,I)) Q:I'?1N.N D
19 .S MCM=$P(^MCAR(MCFILE,MCARGDA,MCNODE,I,0),U,MCPIECE)
20 .Q:MCM="" D SET
21 Q
22SETS Q:'$D(^MCAR(MCFILE,MCARGDA,MCNODE))
23 S J=$P(^MCAR(MCFILE,MCARGDA,MCNODE),U,MCPIECE) Q:J=""
24 ;S MCM=$P($G(^DD(MCFILE,MCFILE1,0)),U,3) Q:MCM=""
25 S MCM=$$GET1^DID(MCFILE,MCFILE1,"","SPECIFIER") Q:MCM=""
26 F K=1:1 S L=$P(MCM,";",K) Q:L="" I $P(L,":",1)=J S MCM=$P(L,":",2) D SET Q
27 Q
28MSET Q:'$D(^MCAR(MCFILE,MCARGDA,MCNODE))
29 F I=0:0 S I=$O(^MCAR(MCFILE,MCARGDA,MCNODE,I)) Q:I'?1N.N D
30 .S J=$P(^MCAR(MCFILE,MCARGDA,MCNODE,I,0),U,MCPIECE)
31 .;Q:J="" S MCM=$P($G(^DD(MCFILE1,.01,0)),U,3)
32 .Q:J="" S MCM=$$GET1^DID(MCFILE1,.01,"","SPECIFIER")
33 .F K=1:1 S L=$P(MCM,";",K) Q:L="" I $P(K,":",1)=J S MCM=$P(K,":",2) D SET Q
34 Q
35 ;
36WP ; word-processing field
37 S $P(MCHEAD,";",2)="W" ; indicate to OE/RR that this is WP
38 S MCMUP=^DD(MCM,0,"UP")
39 S MCMFLD=$O(^DD(MCMUP,"SB",MCM,""))
40 ;S MCNODE=+$P(^DD(MCMUP,MCMFLD,0),"^",4)
41 S MCNODE=$P($$GET1^DID(MCMUP,MCMFLD,"","GLOBAL SUBSCRIPT LOCATION"),";")
42 F I=0:0 S I=$O(^MCAR(MCMUP,MCARGDA,MCNODE,I)) Q:I'?1N.N D
43 .S MCM=^MCAR(MCFILE,MCARGDA,MCNODE,I,0)
44 .I MCM'="" D SET
45 Q
Note: See TracBrowser for help on using the repository browser.