64 lines
2.0 KiB
Mathematica
64 lines
2.0 KiB
Mathematica
MCARDSS ;WISC/RMP-DECISION SUPPORT INTERFACE ;5/5/95 08:01
|
|
;;2.3;Medicine;;09/13/1996
|
|
START(STDATE,ENDATE) ;REMOVE NEW OF SAME AND HARD SET OF SAME
|
|
N TYPE,COUNT,CPTIEN,FILE,CDATE,IEN
|
|
N MCARP,MCDHD,MCESKEY,MCESON,MCESS,MCESSES,MCPATFLD,MCPRO,MCOPT
|
|
N PROC,OPTION,DIR,Y,DTOUT,DIRUT,DIROUT,DUOUT,DHIT,DIOEND,DIROUR
|
|
S (MCARP)="",COUNT=0
|
|
S TYPE="" ;"P" ;should be third input parameter
|
|
K ^TMP($J)
|
|
F S MCARP=$O(^MCAR(694.8,"PS",MCARP)) Q:MCARP'?1N.N D
|
|
.S CPTIEN="" F S CPTIEN=$O(^MCAR(694.8,"PS",MCARP,CPTIEN)) Q:CPTIEN'?1N.N D
|
|
..N CPT
|
|
..S CPT=$$CPT(CPTIEN) Q:CPT=""
|
|
..D PROC(.MCARP,.MCESON,.MCESKEY,.MCPATFLD,.FILE,.MCPRO)
|
|
..Q:MCESON'=1
|
|
..S MCOPT=1 D PIEN
|
|
..Q
|
|
Q
|
|
CPT(IEN) ;
|
|
N TEMP,CPT
|
|
S CPT=""
|
|
I $D(^MCAR(694.8,IEN,1,0)) S TEMP=0 D
|
|
.F Q:CPT?1N.N S TEMP=$O(^MCAR(694.8,IEN,1,TEMP)) Q:TEMP'?1N.N D
|
|
..I $P($P(^(TEMP,0),U),";",2)["ICPT(" S CPT=$P($P(^(0),U),";")
|
|
..Q
|
|
Q CPT
|
|
PIEN ;
|
|
N IEN,CDATE,PROV,FMDT
|
|
S CDATE=$O(^MCAR(FILE,"B",STDATE),-1)
|
|
F S IEN=$$NEXTD(FILE,ENDATE,.CDATE,MCOPT) Q:IEN="" D
|
|
.S PROV=$P(^MCAR(FILE,IEN,"ES"),U,4)
|
|
.S FMDT=$P(^MCAR(FILE,IEN,0),U)
|
|
.Q:(+PROV=0)!(+FMDT=0)
|
|
.S COUNT=COUNT+1
|
|
.;W !,"200^2^FMDT,CPT: ",PROV_U_$$DFN(FILE,IEN,MCPATFLD)_U_FMDT_U_CPT
|
|
.S ^TMP($J,COUNT)=PROV_U_$$DFN(FILE,IEN,MCPATFLD)_U_FMDT_U_CPT
|
|
Q
|
|
DFN(FILE,IEN,MCPATFLD) ;
|
|
N TEMP
|
|
S TEMP=$P(^DD(FILE,MCPATFLD,0),U,4)
|
|
Q $P(^MCAR(FILE,IEN,$P(TEMP,";")),U,$P(TEMP,";",2))
|
|
TEST(REC,OPT,FILE) ;Screens out information
|
|
N STATUS,TEST
|
|
S STATUS=$P($G(^MCAR(FILE,REC,"ES")),U,7) S:STATUS="" STATUS="D"
|
|
S TEST=OPT+$S(STATUS["D":1,1:0)
|
|
Q $S(STATUS="S":0,OPT=3:1,TEST=1:1,TEST=3:1,1:0)
|
|
PROC(MCARP,MCESON,MCESKEY,MCPATFLD,FILE,MCPRO) ;
|
|
N TEMP
|
|
S TEMP=$G(^MCAR(697.2,MCARP,0)),MCESS=0
|
|
S MCESON=+$P(TEMP,U,14),MCESKEY=$P(TEMP,U,15)
|
|
S MCPATFLD=$P(TEMP,U,12)
|
|
S MCESSES=$S(MCESON:1,1:0)
|
|
S FILE=$P($P(TEMP,U,2),"(",2)
|
|
S MCPRO=$P(TEMP,U)
|
|
Q
|
|
NEXTD(FILE,ENDATE,CDATE,MCOPT) ;
|
|
N IEN
|
|
S IEN=""
|
|
F Q:IEN'="" S CDATE=$O(^MCAR(FILE,"B",CDATE)) Q:(CDATE="")!(CDATE>ENDATE) D
|
|
.S IEN=$O(^MCAR(FILE,"B",CDATE,""))
|
|
.S:'$$TEST(IEN,MCOPT,FILE) IEN=""
|
|
.Q
|
|
Q IEN
|