source: FOIAVistA/trunk/r/MEDICINE-MC/MCARDSS.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.0 KB
Line 
1MCARDSS ;WISC/RMP-DECISION SUPPORT INTERFACE ;5/5/95 08:01
2 ;;2.3;Medicine;;09/13/1996
3START(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
19CPT(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
27PIEN ;
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
38DFN(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))
42TEST(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)
47PROC(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
56NEXTD(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
Note: See TracBrowser for help on using the repository browser.