| 1 | MCORMN3 ;WISC/MLH-NON-INTERACTIVE INQUIRY ;4/16/97 15:21
|
|---|
| 2 | ;;2.3;Medicine;**4**;09/13/1996
|
|---|
| 3 | N MCDIQ0
|
|---|
| 4 | Q:'$D(MCDIC)!($D(MCDA)[0)!($D(MCDR)[0) S MCDIL=0,(MCDA(0),MCD0)=MCDA,MCDIQ0=""
|
|---|
| 5 | ;I $D(MCDIQ)#2 G Q:MCDIQ["^"!($E(MCDIQ,1,2)="DI") S:MCDIQ'["(" MCDIQ=MCDIQ_"("
|
|---|
| 6 | S:'$D(MCDIQ(0)) MCDIQ(0)="",MCDIQ0="MCDIQ(0),"
|
|---|
| 7 | I $D(MCDIQ)[0 S MCDIQ="^TMP(""MC"",$J,",MCDIQ0="MCDIQ,"
|
|---|
| 8 | S MCDIQ0=MCDIQ0_"MCDIQ0",MCE="""E"""
|
|---|
| 9 | I MCDIC S MCDIC=$S($D(^DIC(MCDIC,0,"GL")):^("GL"),1:"") G:MCDIC="" Q
|
|---|
| 10 | LEVEL ; handle data at this level
|
|---|
| 11 | G Q:'$D(@(MCDIC_"0)")) S MCDI=+$P(^(0),U,2) G Q:'$D(^(MCDA,0))
|
|---|
| 12 | ; Note: There is no way to be sure of the value of MCDIC.
|
|---|
| 13 | ; We are assuming that it is ^DIC(MCDIC,0,"GL").
|
|---|
| 14 | F I=1:1 S MCDIQ1=$P(MCDR,";",I) Q:MCDIQ1="" D COLON:MCDIQ1[":",FIELD:MCDIQ1>0
|
|---|
| 15 | Q Q:MCDIL K MCPCT,MCF,MCI,MCJ,MCX,MCY,MCC,MCDA(0),MCDRS,MCDIL,MCDI,MCDIQ1,MCE,MCD0 K:MCDIQ0]"" @MCDIQ0
|
|---|
| 16 | Q
|
|---|
| 17 | COLON ; process set of fields delimited by colon
|
|---|
| 18 | S MCDIQ2=$P(MCDIQ1,":",2)
|
|---|
| 19 | F MCDIQ1=MCDIQ1:0 D FIELD S MCDIQ1=$O(^DD(MCDI,MCDIQ1)) I MCDIQ1'>0!(MCDIQ1'<MCDIQ2) S:MCDIQ1'=MCDIQ2 MCDIQ1=0 Q
|
|---|
| 20 | Q
|
|---|
| 21 | FIELD ; process single field
|
|---|
| 22 | Q:'$D(^DD(MCDI,MCDIQ1,0)) S (MCF,MCY)=^(0),MCC=$P(MCF,U,4),MCX=$P(MCC,";",2),MCC=$P(MCC,";",1),MCJ=$P(MCF,U,2) G PROC:MCJ["C"
|
|---|
| 23 | I +MCC'=MCC S MCC=""""_MCC_""""
|
|---|
| 24 | I MCX=0,$D(^DD(+MCJ,.01,0)) G WD:$P(^(0),U,2)["W",SUBFIL ; yes
|
|---|
| 25 | I '$D(@(MCDIC_MCDA_","_MCC_")"))#2 S MCY="" G PROC
|
|---|
| 26 | S MCC=@(MCDIC_MCDA_","_MCC_")"),MCY=$S(MCX["E":$E(MCC,+$P(MCX,"E",2),+$P(MCX,",",2)),1:$P(MCC,U,MCX))
|
|---|
| 27 | I MCDIQ(0)["I",(MCDIQ(0)["N"&(MCY]"")!(MCDIQ(0)'["N")) S @(MCDIQ_"MCDI,MCDA,MCDIQ1,""I"")")=MCY
|
|---|
| 28 | PROC ;process a single datum
|
|---|
| 29 | Q:MCDIQ(0)'["E"&(MCDIQ(0)'="")&(MCDIQ(0)'["N") Q:MCDIQ(0)="IN"!(MCDIQ(0)="NI")
|
|---|
| 30 | I MCJ["C" S D0=MCD0,D1=$G(MCD1),X=MCX,Y=MCY X $P(MCY,U,5,999) K MCY,Y S MCX=X,MCY=MCX
|
|---|
| 31 | I MCJ'["C" S MCC=$P(^DD(MCDI,MCDIQ1,0),U,2) D:MCY]"" SPEC
|
|---|
| 32 | IF MCY'=""!(MCDIQ(0)'["N") D
|
|---|
| 33 | .S @(MCDIQ_MCE_",MCDI,MCDA,MCDIQ1,1)")=MCY
|
|---|
| 34 | Q
|
|---|
| 35 | WD ; word-processing field
|
|---|
| 36 | N MCWP,MCATT S MCWP=0
|
|---|
| 37 | F D WP2 Q:+MCX=0
|
|---|
| 38 | I MCWP'=0 S MCATT=$P(MCF,U,1)_"^W"
|
|---|
| 39 | E S MCATT="^^"
|
|---|
| 40 | ;S @("$P("_MCDIQ_"MCDI,MCDA,MCDIQ1,""F""),U,1,2)=MCATT")
|
|---|
| 41 | Q
|
|---|
| 42 | WP2 ; Note: We cannot be sure of the value of MCDIC.
|
|---|
| 43 | S MCX=$O(@(MCDIC_"MCDA,"_MCC_",MCX)")) Q:+MCX=0
|
|---|
| 44 | S @(MCDIQ_MCE_",MCDI,MCDA,MCDIQ1,MCX)")=^(MCX,0),MCWP=1
|
|---|
| 45 | Q
|
|---|
| 46 | SUBFIL ; process data in a sub-file
|
|---|
| 47 | Q:'$D(MCDR(+MCJ)) Q:'$D(MCDA(+MCJ)) N MCDIQ1,MCI,MCDI S MCDIL=MCDIL+1
|
|---|
| 48 | S MCDRS(MCDIL)=MCDR,MCDIC(MCDIL)=MCDIC,MCDR=MCDR(+MCJ),MCDA(MCDIL)=MCDA
|
|---|
| 49 | S MCDI=+MCJ,MCDIC=MCDIC_MCDA_","_MCC_",",MCDA=MCDA(+MCJ),@("MCD"_MCDIL)=MCDA
|
|---|
| 50 | D LEVEL S MCDR=MCDRS(MCDIL),MCDA=MCDA(MCDIL),MCDIC=MCDIC(MCDIL)
|
|---|
| 51 | K MCDRS(MCDIL),MCDIC(MCDIL),MCDA(MCDIL),@("MCD"_MCDIL)
|
|---|
| 52 | S MCDIL=MCDIL-1 Q
|
|---|
| 53 | SPEC ;
|
|---|
| 54 | I MCC["O",$D(^(2)) X ^(2) Q ;NAKED REFERENCE IS TO ^DD(FILE#,FIELD#,0)
|
|---|
| 55 | SPECS ;Naked Reference for this paragraph reference to ^DD(FILE#,FIELD,0)
|
|---|
| 56 | I MCC["S" S MCC=";"_$P(^(0),U,3),MCPCT=$F(MCC,";"_MCY_":") S:MCPCT MCY=$P($E(MCC,MCPCT,999),";",1) Q
|
|---|
| 57 | I MCC["P",$D(@("^"_$P(^(0),U,3)_"0)")) S MCC=$P(^(0),U,2) Q:'$D(^(MCY,0)) S MCY=$P(^(0),U) I $D(^DD(+MCC,.01,0)) S MCC=$P(^(0),U,2) G SPECS
|
|---|
| 58 | I MCC["V",+MCY,$D(@("^"_$P(MCY,";",2)_"0)")) S MCC=$P(^(0),U,2) Q:'$D(^(+MCY,0)) S MCY=$P(^(0),U) I $D(^DD(+MCC,.01,0)) S MCC=$P(^(0),U,2) G SPECS
|
|---|
| 59 | Q
|
|---|
