| 1 | MCARDSS ;WISC/RMP-DECISION SUPPORT INTERFACE ;5/5/95 08:01
|
|---|
| 2 | ;;2.3;Medicine;;09/13/1996
|
|---|
| 3 | START(STDATE,ENDATE) ;REMOVE NEW OF SAME AND HARD SET OF SAME
|
|---|
| 4 | N TYPE,COUNT,CPTIEN,FILE,CDATE,IEN
|
|---|
| 5 | N MCARP,MCDHD,MCESKEY,MCESON,MCESS,MCESSES,MCPATFLD,MCPRO,MCOPT
|
|---|
| 6 | N PROC,OPTION,DIR,Y,DTOUT,DIRUT,DIROUT,DUOUT,DHIT,DIOEND,DIROUR
|
|---|
| 7 | S (MCARP)="",COUNT=0
|
|---|
| 8 | S TYPE="" ;"P" ;should be third input parameter
|
|---|
| 9 | K ^TMP($J)
|
|---|
| 10 | F S MCARP=$O(^MCAR(694.8,"PS",MCARP)) Q:MCARP'?1N.N D
|
|---|
| 11 | .S CPTIEN="" F S CPTIEN=$O(^MCAR(694.8,"PS",MCARP,CPTIEN)) Q:CPTIEN'?1N.N D
|
|---|
| 12 | ..N CPT
|
|---|
| 13 | ..S CPT=$$CPT(CPTIEN) Q:CPT=""
|
|---|
| 14 | ..D PROC(.MCARP,.MCESON,.MCESKEY,.MCPATFLD,.FILE,.MCPRO)
|
|---|
| 15 | ..Q:MCESON'=1
|
|---|
| 16 | ..S MCOPT=1 D PIEN
|
|---|
| 17 | ..Q
|
|---|
| 18 | Q
|
|---|
| 19 | CPT(IEN) ;
|
|---|
| 20 | N TEMP,CPT
|
|---|
| 21 | S CPT=""
|
|---|
| 22 | I $D(^MCAR(694.8,IEN,1,0)) S TEMP=0 D
|
|---|
| 23 | .F Q:CPT?1N.N S TEMP=$O(^MCAR(694.8,IEN,1,TEMP)) Q:TEMP'?1N.N D
|
|---|
| 24 | ..I $P($P(^(TEMP,0),U),";",2)["ICPT(" S CPT=$P($P(^(0),U),";")
|
|---|
| 25 | ..Q
|
|---|
| 26 | Q CPT
|
|---|
| 27 | PIEN ;
|
|---|
| 28 | N IEN,CDATE,PROV,FMDT
|
|---|
| 29 | S CDATE=$O(^MCAR(FILE,"B",STDATE),-1)
|
|---|
| 30 | F S IEN=$$NEXTD(FILE,ENDATE,.CDATE,MCOPT) Q:IEN="" D
|
|---|
| 31 | .S PROV=$P(^MCAR(FILE,IEN,"ES"),U,4)
|
|---|
| 32 | .S FMDT=$P(^MCAR(FILE,IEN,0),U)
|
|---|
| 33 | .Q:(+PROV=0)!(+FMDT=0)
|
|---|
| 34 | .S COUNT=COUNT+1
|
|---|
| 35 | .;W !,"200^2^FMDT,CPT: ",PROV_U_$$DFN(FILE,IEN,MCPATFLD)_U_FMDT_U_CPT
|
|---|
| 36 | .S ^TMP($J,COUNT)=PROV_U_$$DFN(FILE,IEN,MCPATFLD)_U_FMDT_U_CPT
|
|---|
| 37 | Q
|
|---|
| 38 | DFN(FILE,IEN,MCPATFLD) ;
|
|---|
| 39 | N TEMP
|
|---|
| 40 | S TEMP=$P(^DD(FILE,MCPATFLD,0),U,4)
|
|---|
| 41 | Q $P(^MCAR(FILE,IEN,$P(TEMP,";")),U,$P(TEMP,";",2))
|
|---|
| 42 | TEST(REC,OPT,FILE) ;Screens out information
|
|---|
| 43 | N STATUS,TEST
|
|---|
| 44 | S STATUS=$P($G(^MCAR(FILE,REC,"ES")),U,7) S:STATUS="" STATUS="D"
|
|---|
| 45 | S TEST=OPT+$S(STATUS["D":1,1:0)
|
|---|
| 46 | Q $S(STATUS="S":0,OPT=3:1,TEST=1:1,TEST=3:1,1:0)
|
|---|
| 47 | PROC(MCARP,MCESON,MCESKEY,MCPATFLD,FILE,MCPRO) ;
|
|---|
| 48 | N TEMP
|
|---|
| 49 | S TEMP=$G(^MCAR(697.2,MCARP,0)),MCESS=0
|
|---|
| 50 | S MCESON=+$P(TEMP,U,14),MCESKEY=$P(TEMP,U,15)
|
|---|
| 51 | S MCPATFLD=$P(TEMP,U,12)
|
|---|
| 52 | S MCESSES=$S(MCESON:1,1:0)
|
|---|
| 53 | S FILE=$P($P(TEMP,U,2),"(",2)
|
|---|
| 54 | S MCPRO=$P(TEMP,U)
|
|---|
| 55 | Q
|
|---|
| 56 | NEXTD(FILE,ENDATE,CDATE,MCOPT) ;
|
|---|
| 57 | N IEN
|
|---|
| 58 | S IEN=""
|
|---|
| 59 | F Q:IEN'="" S CDATE=$O(^MCAR(FILE,"B",CDATE)) Q:(CDATE="")!(CDATE>ENDATE) D
|
|---|
| 60 | .S IEN=$O(^MCAR(FILE,"B",CDATE,""))
|
|---|
| 61 | .S:'$$TEST(IEN,MCOPT,FILE) IEN=""
|
|---|
| 62 | .Q
|
|---|
| 63 | Q IEN
|
|---|
