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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARDSS 2129 printed Dec 13, 2024@02:12:46 Page 2
MCARDSS ;WISC/RMP-DECISION SUPPORT INTERFACE ;5/5/95 08:01
+1 ;;2.3;Medicine;;09/13/1996
START(STDATE,ENDATE) ;REMOVE NEW OF SAME AND HARD SET OF SAME
+1 NEW TYPE,COUNT,CPTIEN,FILE,CDATE,IEN
+2 NEW MCARP,MCDHD,MCESKEY,MCESON,MCESS,MCESSES,MCPATFLD,MCPRO,MCOPT
+3 NEW PROC,OPTION,DIR,Y,DTOUT,DIRUT,DIROUT,DUOUT,DHIT,DIOEND,DIROUR
+4 SET (MCARP)=""
SET COUNT=0
+5 ;"P" ;should be third input parameter
SET TYPE=""
+6 KILL ^TMP($JOB)
+7 FOR
SET MCARP=$ORDER(^MCAR(694.8,"PS",MCARP))
if MCARP'?1N.N
QUIT
Begin DoDot:1
+8 SET CPTIEN=""
FOR
SET CPTIEN=$ORDER(^MCAR(694.8,"PS",MCARP,CPTIEN))
if CPTIEN'?1N.N
QUIT
Begin DoDot:2
+9 NEW CPT
+10 SET CPT=$$CPT(CPTIEN)
if CPT=""
QUIT
+11 DO PROC(.MCARP,.MCESON,.MCESKEY,.MCPATFLD,.FILE,.MCPRO)
+12 if MCESON'=1
QUIT
+13 SET MCOPT=1
DO PIEN
+14 QUIT
End DoDot:2
End DoDot:1
+15 QUIT
CPT(IEN) ;
+1 NEW TEMP,CPT
+2 SET CPT=""
+3 IF $DATA(^MCAR(694.8,IEN,1,0))
SET TEMP=0
Begin DoDot:1
+4 FOR
if CPT?1N.N
QUIT
SET TEMP=$ORDER(^MCAR(694.8,IEN,1,TEMP))
if TEMP'?1N.N
QUIT
Begin DoDot:2
+5 IF $PIECE($PIECE(^(TEMP,0),U),";",2)["ICPT("
SET CPT=$PIECE($PIECE(^(0),U),";")
+6 QUIT
End DoDot:2
End DoDot:1
+7 QUIT CPT
PIEN ;
+1 NEW IEN,CDATE,PROV,FMDT
+2 SET CDATE=$ORDER(^MCAR(FILE,"B",STDATE),-1)
+3 FOR
SET IEN=$$NEXTD(FILE,ENDATE,.CDATE,MCOPT)
if IEN=""
QUIT
Begin DoDot:1
+4 SET PROV=$PIECE(^MCAR(FILE,IEN,"ES"),U,4)
+5 SET FMDT=$PIECE(^MCAR(FILE,IEN,0),U)
+6 if (+PROV=0)!(+FMDT=0)
QUIT
+7 SET COUNT=COUNT+1
+8 ;W !,"200^2^FMDT,CPT: ",PROV_U_$$DFN(FILE,IEN,MCPATFLD)_U_FMDT_U_CPT
+9 SET ^TMP($JOB,COUNT)=PROV_U_$$DFN(FILE,IEN,MCPATFLD)_U_FMDT_U_CPT
End DoDot:1
+10 QUIT
DFN(FILE,IEN,MCPATFLD) ;
+1 NEW TEMP
+2 SET TEMP=$PIECE(^DD(FILE,MCPATFLD,0),U,4)
+3 QUIT $PIECE(^MCAR(FILE,IEN,$PIECE(TEMP,";")),U,$PIECE(TEMP,";",2))
TEST(REC,OPT,FILE) ;Screens out information
+1 NEW STATUS,TEST
+2 SET STATUS=$PIECE($GET(^MCAR(FILE,REC,"ES")),U,7)
if STATUS=""
SET STATUS="D"
+3 SET TEST=OPT+$SELECT(STATUS["D":1,1:0)
+4 QUIT $SELECT(STATUS="S":0,OPT=3:1,TEST=1:1,TEST=3:1,1:0)
PROC(MCARP,MCESON,MCESKEY,MCPATFLD,FILE,MCPRO) ;
+1 NEW TEMP
+2 SET TEMP=$GET(^MCAR(697.2,MCARP,0))
SET MCESS=0
+3 SET MCESON=+$PIECE(TEMP,U,14)
SET MCESKEY=$PIECE(TEMP,U,15)
+4 SET MCPATFLD=$PIECE(TEMP,U,12)
+5 SET MCESSES=$SELECT(MCESON:1,1:0)
+6 SET FILE=$PIECE($PIECE(TEMP,U,2),"(",2)
+7 SET MCPRO=$PIECE(TEMP,U)
+8 QUIT
NEXTD(FILE,ENDATE,CDATE,MCOPT) ;
+1 NEW IEN
+2 SET IEN=""
+3 FOR
if IEN'=""
QUIT
SET CDATE=$ORDER(^MCAR(FILE,"B",CDATE))
if (CDATE="")!(CDATE>ENDATE)
QUIT
Begin DoDot:1
+4 SET IEN=$ORDER(^MCAR(FILE,"B",CDATE,""))
+5 if '$$TEST(IEN,MCOPT,FILE)
SET IEN=""
+6 QUIT
End DoDot:1
+7 QUIT IEN
