89 lines
3.8 KiB
Mathematica
89 lines
3.8 KiB
Mathematica
MCORMN1 ;WISC/DCB-BUILD INTERMEDIATE DATA SET ;4/16/97 15:21
|
|
;;2.3;Medicine;**4**;09/13/1996
|
|
GETDATA(MCPROC,MCENT,MCDEST,MCFILE,TYPE) ;function to get data defined by data set MCDSNAM
|
|
N MCA,MCB,MCDA,MCDA,MCDIC,MCDIQ,MCDR,MCDSIX,MCROOT,MCTEMP,MCDRDR
|
|
N MCDSR,MCERR,MCFIL,MCFTMP,MCL2,MCL3,MCMU,MCMM,MCDSIX,MCDSR
|
|
N MCROOT,MCSF,MCSFIND,MCSFLD,MCSFREC,MCSUBFA,MCTMP,MCTMP1
|
|
N MCFLDIX,MCFLDNO,MCFLDNO,MCFLDREC,MCFLDUSE,MCSUBFNU,MCFIL,MCDD
|
|
N MCSBFILE,MCSREC,MCREC,MCFLD,MCTYPE,MCDSIX1,MCGPROC,MCGFILE,MCPATFLD
|
|
S MCTYPE=$S(TYPE="RD":"F",1:"B")
|
|
I '$D(MCDEST) S MCDEST="^TMP(""MC"",$J)"
|
|
N MCDSIX,MCDSOK
|
|
S MCGPROC=$O(^MCAR(697.2,"B",MCPROC,"")),MCPATFLD=$P($G(^MCAR(697.2,MCGPROC,0)),U,12),(MCDSIX1,MCDSIX)=0
|
|
F S MCDSIX1=+$O(^MCAR(690.2,"D",MCGPROC,MCDSIX1)) Q:MCDSIX1=0!(MCDSIX'=0) D
|
|
.Q:'$D(^MCAR(690.2,MCDSIX1,0))
|
|
.S:$P(^MCAR(690.2,MCDSIX1,0),U,3)=MCTYPE MCDSIX=MCDSIX1
|
|
Q:MCDSIX=0 0
|
|
S MCDSR=^MCAR(690.2,MCDSIX,0),MCGFILE=$P(MCDSR,U,2)
|
|
TTT S MCROOT=^DIC(MCGFILE,0,"GL")
|
|
I $$MEDID(MCGFILE,MCENT,PATID,MCPATFLD)=0 W !,"File/Patient ID mismatch" Q 0
|
|
D GETITEM Q 1
|
|
;
|
|
GETITEM ; subroutine to get data defined in data set index MCDSIX for file entry MCENT
|
|
D SORTFLDS ; sort out the single and multiple fields
|
|
D MULTI ; process the multiple fields
|
|
Q
|
|
SORTFLDS ; sort out the single and multiple fields
|
|
;S MCFLD="",MCDR=""
|
|
K MCDRDR S MCFLD="",MCDRDR=0
|
|
F S MCFLD=$O(^MCAR(690.2,MCDSIX,1,"B",MCFLD)) Q:MCFLD="" D SORT1
|
|
;S MCDIC=MCGFILE,MCDA=MCENT,MCDIQ=MCDEST,MCDIQ(0)="EF"
|
|
S MCDIC=MCGFILE,MCDA=MCENT,MCDIQ(0)="EF"
|
|
I $E(MCDEST,$L(MCDEST))=")" S MCDIQ=$E(MCDEST,1,$L(MCDEST)-1)_","
|
|
E S MCDIQ=MCDEST
|
|
D ^MCORMN2
|
|
Q
|
|
SORT1 ;
|
|
S MCFLDIX=+$O(^MCAR(690.2,MCDSIX,1,"B",MCFLD,"")) Q:MCFLDIX=0
|
|
S MCFLDREC=$G(^MCAR(690.2,MCDSIX,1,MCFLDIX,0)) Q:MCFLDREC=""
|
|
S MCFLDNO=$P(MCFLDREC,"^",1),MCFLDUSE=$P(MCFLDREC,"^",2)
|
|
S MCTMP=^DD(MCGFILE,MCFLDNO,0)
|
|
;I $L(MCDR)<200 S MCDR=MCDR_MCFLD_";" ;TEMP FIX
|
|
S MCDRDR=MCDRDR+1,MCDRDR(MCDRDR)=MCFLD ;REAL FIX
|
|
S @MCDEST@("F",MCGFILE,MCFLDNO,0)=$P(MCTMP,U,1,2)_U_MCFLDUSE
|
|
S @MCDEST@("F",MCGFILE,MCFLDNO,1)=$P(MCFLDREC,U,3,255)
|
|
Q
|
|
MULTI ; Get the Sub-file data
|
|
S MCSBFILE="" K MCDRDR
|
|
F S MCSBFILE=$O(^MCAR(690.2,MCDSIX,2,"B",MCSBFILE)) Q:MCSBFILE="" D MULTIF
|
|
Q
|
|
MULTIF ; Get the fields they need
|
|
S MCREC=$O(^MCAR(690.2,MCDSIX,2,"B",MCSBFILE,"")) Q:MCREC=""
|
|
Q:'$D(^MCAR(690.2,MCDSIX,2,MCREC,0))
|
|
S MCSUBFNU=^MCAR(690.2,MCDSIX,2,MCREC,0),MCSFLD=""
|
|
K MCSUBFA,MCSFREC
|
|
S MCDR(MCSBFILE)=""
|
|
F S MCSFLD=$O(^MCAR(690.2,MCDSIX,2,MCREC,1,"B",MCSFLD)) Q:MCSFLD="" D SUBFLD
|
|
S MCDR=$O(^DD(MCFILE,"SB",MCSUBFNU,"")) I MCDR="" Q
|
|
S MCDRDR(1)=MCDR
|
|
;S MCTMP=$P($G(^DD(MCGFILE,MCDR,0)),U,4) Q:MCTMP=""
|
|
S MCTMP=$$GET1^DID(MCGFILE,MCDR,"","GLOBAL SUBSCRIPT LOCATION") Q:MCTMP=""
|
|
S MCA=$P(MCTMP,";",1),MCB=$P(MCTMP,";",2),MCDIQ(0)="EF",MCFTMP=MCFILE
|
|
S MCDIQ(0)="EF",MCSFIND=0
|
|
F S MCSFIND=$O(^MCAR(MCGFILE,MCENT,MCA,MCSFIND)) Q:+MCSFIND=0 D HITIT
|
|
Q
|
|
SUBFLD ; Build the fields
|
|
S MCSREC=$O(^MCAR(690.2,MCDSIX,2,MCREC,1,"B",MCSFLD,"")) Q:MCSREC=""
|
|
S MCTMP=$G(^MCAR(690.2,MCDSIX,2,MCREC,1,MCSREC,0)),MCD1=MCSREC
|
|
S MCDD=$G(^DD(MCSBFILE,MCSFLD,0)) Q:MCDD=""
|
|
S MCDR(MCSBFILE)=MCDR(MCSBFILE)_MCSFLD_";"
|
|
D SETNODE
|
|
Q
|
|
HITIT ; Get the data that are out there FROM MULTI.
|
|
S MCDA(MCSUBFNU)=MCSFIND
|
|
D ^MCORMN3
|
|
Q
|
|
SETNODE ;
|
|
S TEMP=$P(MCDD,U,1,2)_U_$P(MCTMP,U,2,3)
|
|
S @MCDEST@("F",MCSBFILE,MCSFLD,0)=TEMP
|
|
S @MCDEST@("F",MCSBFILE,MCSFLD,1)=$P(MCTMP,U,3,255)
|
|
Q
|
|
MEDID(MCGFILE,MCENT,PATID,MCPATFLD) ;
|
|
N IEN,FILE,NODE,PIECE
|
|
S IEN=$S(+MCPATFLD>0:MCPATFLD,1:1)
|
|
;S NODE=$P($P(^DD(MCGFILE,IEN,0),U,4),";"),PIECE=+$P(^(0),";",2)
|
|
S NODE=$P($$GET1^DID(MCGFILE,IEN,"","GLOBAL SUBSCRIPT LOCATION"),";"),PIECE=+$P($$GET1^DID(MCGFILE,IEN,"","GLOBAL SUBSCRIPT LOCATION"),";",2)
|
|
;W !," NODE ",NODE," PIECE ",PIECE,!
|
|
;W !," test ",+$P($G(^MCAR(MCGFILE,MCENT,NODE)),U,PIECE)
|
|
Q $S(IEN="":0,PATID=+$P($G(^MCAR(MCGFILE,MCENT,NODE)),U,PIECE):1,1:0)
|