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