222 lines
9.5 KiB
Mathematica
222 lines
9.5 KiB
Mathematica
MDPS1 ; HOIFO/NCA - CP/Medicine Report Generator ;5/18/04 09:48
|
|
;;1.0;CLINICAL PROCEDURES;**2,10,13**;Apr 01, 2004;Build 19
|
|
; Integration Agreements:
|
|
; IA# 2693 [Subscription] TIU Extractions.
|
|
; IA# 2926 [Subscription] Calls to GMRCGUIA.
|
|
; IA# 2944 [Subscription] Calls to TIUSRVR1.
|
|
; IA# 3067 [Private] Read fields in Consult file (#123) w/FM
|
|
; IA# 4110 [Subscription] Read access field #50 Associated Results in
|
|
; Consult file (#123) w/FM
|
|
; IA# 4230 [Subscription] Document MDPS1 calls.
|
|
; IA# 4231 [Subscription] Document CKP^GMTSUP usage.
|
|
; IA# 4792 [Private] CANDO^TIUSRVA call
|
|
; IA# 10104 [Supported] Routine XLFSTR calls
|
|
;
|
|
; Pre-existing local variables
|
|
; DFN,GMTS1,GMTS2,GMTSNDM,GMTSNPG,GMTSQIT
|
|
;
|
|
EN1(MDGLO,MDDFN,MDSDT,MDEDT,MDMAX,MDPSC,MDALL) ; Return the List of Completed Studies
|
|
; Input: MDGLO - Return Global Array (Required)
|
|
; MDDFN - Patient DFN (Required)
|
|
; MDSDT - Start Date in FM Internal Format (Optional)
|
|
; MDEDT - End Date in FM Internal Format (Optional)
|
|
; MDMAX - Number of studies to return (Optional)
|
|
; MDPSC - Procedure Summary Code (Optional)
|
|
; MDALL - Return the all text reports with
|
|
; the procedures list (Optional)
|
|
; (Returns all studies for Patient, if no MDSDT, MDEDT,and MDMAX.)
|
|
;
|
|
I '$G(MDDFN)!('$D(MDGLO)) Q
|
|
I $G(MDGLO)="" S MDGLO=$NA(^TMP("MDHSP",$J))
|
|
N MDARR,MDCODE,MDCON,MDCTR,MDDTE,MDLP,MDLP1,MDPLST,MDPROC,MDSTAT,MDT,MDTIUER,MDX,Y
|
|
S (MDIMG,MDCTR)=0,(MDCODE,MDDTE,MDTIUER)="",MDC=$G(MDPSC)
|
|
K ^TMP("MDPLST",$J) S MDPLST=$NA(^TMP("MDPLST",$J))
|
|
;
|
|
; If not converted call old medicine gather routine
|
|
D:$G(MDC)="" GP^MDPS4(MDDFN,MDSDT,MDEDT)
|
|
I '$G(MDSDT),'$G(MDEDT) D EN^MDARP3(MDDFN,MDC)
|
|
E D EN^MCARPS3(MDDFN,MDC,MDSDT,MDEDT)
|
|
;
|
|
; Get CP procedures
|
|
D GET702(.MDGLO,MDDFN,MDC,MDSDT,MDEDT,$S(+$G(MDMAX):MDMAX,1:999))
|
|
K ^TMP("MDPLST",$J)
|
|
Q
|
|
;
|
|
GET702(MDGLO,MDDFN,MDC,MDSDT,MDEDT,MDMAX) ; Gather the new 702 entries
|
|
S MDLP="" F S MDLP=$O(^MDD(702,"B",MDDFN,MDLP)) Q:MDLP<1 D
|
|
.S MDX=$G(^MDD(702,MDLP,0)) Q:$P(MDX,"^",9)'=3
|
|
.S MDPROC=$$GET1^DIQ(702,MDLP_",",.04,"E") Q:MDPROC=""
|
|
.Q:'$P(MDX,U,6)
|
|
.K ^TMP("MDTIUST",$J) S MDTIUER=""
|
|
.D EXTRACT^TIULQ($P(MDX,U,6),"^TMP(""MDTIUST"",$J)",MDTIUER,".01;.05;70201;70202") Q:+MDTIUER
|
|
.S MDCODE=$G(^TMP("MDTIUST",$J,$P(MDX,U,6),70201,"E"))
|
|
.S:MDCODE'="" MDCODE=$$UP^XLFSTR(MDCODE)
|
|
.I $G(MDC)'="" Q:MDCODE'=$G(MDC)
|
|
.S MDDTE=$G(^TMP("MDTIUST",$J,$P(MDX,U,6),70202,"I"))
|
|
.S MDSTAT=$G(^TMP("MDTIUST",$J,$P(MDX,U,6),.05,"E"))
|
|
.S:'MDDTE MDDTE=$$GET1^DIQ(702,MDLP_",",.02,"I")
|
|
.K ^TMP("MDTIUST",$J)
|
|
.S MDCON=$P(MDX,U,5)
|
|
.I +$G(MDSDT) Q:MDDTE<+$G(MDSDT)
|
|
.I +$G(MDEDT) Q:MDDTE>+$G(MDEDT)
|
|
.I MDCON D Q:MDSTAT'="COMPLETE"&(MDSTAT'="PARTIAL RESULTS")
|
|
..S MDSTAT=$$GET1^DIQ(123,MDCON_",",8,"E")
|
|
..I MDSTAT="" S MDSTAT=$$GET1^DIQ(123,MDCON_",",8,"I") S:+MDSTAT MDSTAT=$$GET1^DIQ(100.01,MDSTAT_",",.01,"E")
|
|
..Q
|
|
.S Y=MDDTE X ^DD("DD")
|
|
.I MDCON Q:$G(MDARR(MDCON))'="" S MDARR(MDCON)=MDCON
|
|
.S:$G(^TMP("MDPLST",$J,(9999999.9999-MDDTE),MDPROC_"~"_MDLP))="" ^(MDPROC_"~"_MDLP)=MDPROC_"^"_MDLP_"^"_"PR702"_"^"_"MDPS1"_"^^"_Y_"^"_MDCODE_"^^^^"_MDPROC_"^^"_MDCON_"^"_+$P(MDX,U,6)
|
|
.Q
|
|
S MDCTR=0
|
|
S MDLP="" F S MDLP=$O(^TMP("MDPLST",$J,MDLP)) Q:MDLP="" S MDLP1="" F S MDLP1=$O(^TMP("MDPLST",$J,MDLP,MDLP1)) Q:MDLP1="" S MDX=$G(^(MDLP1)) D
|
|
.I +$G(MDMAX) Q:MDCTR=MDMAX
|
|
.S MDCTR=MDCTR+1,@MDGLO@(MDCTR)=$G(MDX)
|
|
K MDARR
|
|
I +$G(MDALL) K ^TMP("MDPTXT",$J) S MDLP=0 F S MDLP=$O(@MDGLO@(MDLP)) Q:MDLP<1 S MDX1=$G(@MDGLO@(MDLP)) D
|
|
.S MCARGDA=+$P(MDX1,U,2),MCPRO=$P(MDX1,U,11),MCARPPS=$P(MDX1,U,3,4)
|
|
.S MCARGRTN=$P(MDX1,U,5),MDT="RD"
|
|
.D @MCARPPS
|
|
K MCARGDA,MCARGRTN,MCPRO,MCARPPS
|
|
Q
|
|
CPA ; Abnormal Report - Health Summary Component
|
|
N MDHR,MDHSG,MDHDR,MDHFLG,MDLIM,MDTS1,MDTS2,MDX1
|
|
Q:'$G(DFN) Q:'$G(GMTS1) Q:'$G(GMTS2)
|
|
K ^TMP("MDHSP",$J) S MDHFLG=1
|
|
S MDHSG=$NA(^TMP("MDHSP",$J)) D SET^MDPS2
|
|
D EN1(.MDHSG,DFN,MDTS1,MDTS2,MDLIM,"ABNORMAL")
|
|
I '$D(^TMP("MDHSP",$J)) D CKP^GMTSUP Q:$D(GMTSQIT) W !,"No Procedure Data for the patient." Q
|
|
S MDHR=0 F S MDHR=$O(^TMP("MDHSP",$J,MDHR)) Q:MDHR<1 S MDX1=$G(^(MDHR)) D
|
|
.D HSHDR^MDPS2
|
|
.S MCARGDA=+$P(MDX1,U,2),MCARPPS=$P(MDX1,U,3,4),MCPRO=$P(MDX1,U,11)
|
|
.S MCARGRTN=$P(MDX1,U,5),MDT="RD",MDHDR=1
|
|
.D @MCARPPS Q
|
|
K ^TMP("MDHSP",$J),MCARGRTN,MCPRO,MCARPPS
|
|
Q
|
|
CPB ; Brief Report - Health Summary Component
|
|
N MDHR,MDHSG,MDLIM,MDTS1,MDTS2,MDX1
|
|
Q:'$G(DFN) Q:'$G(GMTS1) Q:'$G(GMTS2)
|
|
K ^TMP("MDHSP",$J)
|
|
S MDHSG=$NA(^TMP("MDHSP",$J)) D SET^MDPS2
|
|
D EN1(.MDHSG,DFN,MDTS1,MDTS2,MDLIM)
|
|
I '$D(^TMP("MDHSP",$J)) D CKP^GMTSUP Q:$D(GMTSQIT) W !,"No Procedure Data for the patient." Q
|
|
D HDR^MDPS2
|
|
S MDHR=0 F S MDHR=$O(^TMP("MDHSP",$J,MDHR)) Q:MDHR<1 S MDX1=$G(^(MDHR)) D
|
|
.D CKP^GMTSUP Q:$D(GMTSQIT)
|
|
.W !,$S(+$P(MDX1,U,13):$J($P(MDX1,U,13),9),1:""),?12,$E($P(MDX1,U,1),1,30),?44,$P(MDX1,U,6),?67,$P(MDX1,U,7)
|
|
.Q
|
|
K ^TMP("MDHSP",$J)
|
|
Q
|
|
CPC ; Full Caption Report - Health Summary Component
|
|
S MDT1="CD"
|
|
CPF ; Full Report - Health Summary Component
|
|
N MDHR,MDHSG,MDHDR,MDHFLG,MDLIM,MDT,MDTS1,MDTS2,MDX1
|
|
Q:'$G(DFN) Q:'$G(GMTS1) Q:'$G(GMTS2)
|
|
K ^TMP("MDHSP",$J) S MDHFLG=1
|
|
S MDHSG=$NA(^TMP("MDHSP",$J)) D SET^MDPS2
|
|
D EN1(.MDHSG,DFN,MDTS1,MDTS2,MDLIM)
|
|
I '$D(^TMP("MDHSP",$J)) D CKP^GMTSUP Q:$D(GMTSQIT) W !,"No Procedure Data for the patient." Q
|
|
S MDHR=0 F S MDHR=$O(^TMP("MDHSP",$J,MDHR)) Q:MDHR<1 S MDX1=$G(^(MDHR)) D
|
|
.D HSHDR^MDPS2
|
|
.S MCARGDA=+$P(MDX1,U,2),MCPRO=$P(MDX1,U,11),MCARPPS=$P(MDX1,U,3,4)
|
|
.S MCARGRTN=$P(MDX1,U,5),MDT=$S($G(MDT1)="":"RD",1:"CD"),MDHDR=1
|
|
.D @MCARPPS Q
|
|
K ^TMP("MDHSP",$J),MCARGDA,MCARGRTN,MCPRO,MCARPPS,MDT1
|
|
Q
|
|
CPS ; One Line Summary Report
|
|
N MDHR,MDHSG,MDLIM,MDTS1,MDTS2,MDX1
|
|
Q:'$G(DFN) Q:'$G(GMTS1) Q:'$G(GMTS2)
|
|
K ^TMP("MDHSP",$J)
|
|
S MDHSG=$NA(^TMP("MDHSP",$J)) D SET^MDPS2
|
|
D EN1(.MDHSG,DFN,MDTS1,MDTS2,MDLIM)
|
|
I '$D(^TMP("MDHSP",$J)) D CKP^GMTSUP Q:$D(GMTSQIT) W !,"No Procedure Data for the patient." Q
|
|
S MDHR=0 F S MDHR=$O(^TMP("MDHSP",$J,MDHR)) Q:MDHR<1 S MDX1=$G(^(MDHR)) D
|
|
.D HSHDR^MDPS2
|
|
K ^TMP("MDHSP",$J)
|
|
Q
|
|
PR702 ; Return the Result Text for File 702 records
|
|
Q:'$G(MCARGDA)
|
|
N FFF,MDCLIN,MDCON,MDIMG,MDMCG,MDMED,MDREC,MDPRILV,MDPTR,MDSTUDY,MDTIU,MDX4,PATID,MDRPG,RESULTS
|
|
I '$G(MDALL) K ^TMP("MDPTXT",$J)
|
|
S MDIMG=0,$P(FFF,"-",80)="",MDRPG=0
|
|
S MDSTUDY=+$G(MCARGDA)
|
|
S MDTIU=$$GET1^DIQ(702,MDSTUDY_",",.06,"I")
|
|
S MDCON=$$GET1^DIQ(702,MDSTUDY_",",.05,"I")
|
|
Q:'MDTIU
|
|
I +$P($G(^MDD(702,MDSTUDY,.1,0)),U,4)>0 S MDIMG=1
|
|
S (MDPRILV,RESULTS)="",MDCLIN=0
|
|
D CANDO^TIUSRVA(.MDPRILV,+MDTIU,"VIEW")
|
|
I +MDPRILV<1 S ^TMP("MDPTXT",$J,MCARGDA,MCPRO,1)=$P(MDPRILV,U,2) D NXT Q
|
|
I 'MDCON D TGET^TIUSRVR1(.RESULTS,+MDTIU) M ^TMP("MDPTXT",$J,MCARGDA,MCPRO)=@RESULTS K ^TMP("TIUVIEW",$J) Q:+$G(MDALL) D NXT Q
|
|
I MDCON D Q:+$G(MDMED)
|
|
.S MDG=$NA(^TMP("MDPTXT",$J,MCARGDA,MCPRO))
|
|
.S MDMED=$$CHKMED^MDPS3(MDCON)
|
|
.I MDMED D GETARY(.MDG,MDCON) Q:+$G(MDALL) Q:+$G(MDRDV) D NXT Q
|
|
.K ^TMP("MDGMRC",$J) S RESULTS=$NA(^TMP("MDGMRC",$J))
|
|
.D RT^GMRCGUIA(MDCON,.RESULTS)
|
|
.D SETLINE(.MDG,.RESULTS)
|
|
NXT Q:+$G(MDALL) Q:+$G(MDRDV)
|
|
I $D(ORHFS) U IO G PRINT
|
|
G PRINT
|
|
PR690 ; Return the Result text for File 690 Medicine report record
|
|
Q:'$G(MCARGDA)
|
|
N MDSTUDY,RESULTS,MDTMP,PATID
|
|
I '$G(MDALL) K ^TMP("MDPTXT",$J)
|
|
S MDSTUDY=+$G(MCARGDA)
|
|
S MDG=$NA(^TMP("MDPTXT",$J,MCARGDA,MCPRO))
|
|
S MDTMP="",MDTMP=+$O(^MCAR(697.2,"B",MCPRO,MDTMP))
|
|
S MDTMP=$G(^MCAR(697.2,+MDTMP,0)) Q:MDTMP=""
|
|
S MDF=$P(MDTMP,U,2),MDF=$P(MDF,"(",2),MDR=+MCARGDA,MDPR=MCPRO,PATID=DFN S:$G(MDT)="" MDT="RD"
|
|
D GETDATA^MDPS2(.MDG,DFN,MDPR,MDF,MDR,MDT,$S(+$G(MDHDR):MDHDR,1:0))
|
|
Q:+$G(MDALL) Q:+$G(MDRDV)
|
|
I $D(ORHFS) U IO G PRINT
|
|
PRINT ; Print the text for Display
|
|
N MDRE S MDREC=$NA(^TMP("MDPTXT",$J)),MDRPG=1,MDRE=+$P(MDREC,",",2)
|
|
W:'$G(MDHFLG) @IOF,!!
|
|
F S MDREC=$Q(@MDREC) Q:MDREC="" Q:$QS(MDREC,1)'="MDPTXT" D
|
|
.Q:$QS(MDREC,2)'=MDRE
|
|
.I +$G(MDHFLG) D CKP^GMTSUP Q:$D(GMTSQIT)
|
|
.I '$G(MDHFLG)&($Y>(IOSL-6)!($Y<1)) W @IOF D HDR^MDPS3
|
|
.W !,$G(@MDREC)
|
|
.Q
|
|
I +$G(MDIMG) D
|
|
.I +$G(MDHFLG) D CKP^GMTSUP Q:$D(GMTSQIT)
|
|
.W ! I +$G(MDHFLG) D CKP^GMTSUP Q:$D(GMTSQIT)
|
|
.W !,"NOTE: Images are associated with this procedure."
|
|
.I +$G(MDHFLG) D CKP^GMTSUP Q:$D(GMTSQIT)
|
|
.W !," Please use Imaging Display to view the images."
|
|
.Q
|
|
K MCPRO,MCARPPS,MCARGRTN,^TMP("MDPTXT",$J)
|
|
Q
|
|
GETARY(MDG,MDCON) ; Get the Medicine Result
|
|
N MDCK,MDCX,MDX4,MDGL
|
|
K ^TMP("MDREST",$J) S MDGL=$NA(^TMP("MDREST",$J))
|
|
D GETS^DIQ(123,MDCON_",","50*","I","MDCX")
|
|
S MDCK="" F S MDCK=$O(MDCX(123.03,MDCK)) Q:MDCK<1 S MDX4=$G(MDCX(123.03,MDCK,.01,"I")) D
|
|
.I MDX4["MCAR" D Q
|
|
..S MDR=+MDX4,MDF=+$P(MDX4,"(",2),PATID=DFN S:$G(MDT)="" MDT="RD"
|
|
..Q:MDX4="" S MCPRO=$$PRO^MDPS3(MDX4),MDPR=MCPRO
|
|
..D GETDATA^MDPS2(.MDGL,DFN,MDPR,MDF,MDR,MDT,$S(+$G(MDHDR):1,1:0))
|
|
..D SETLINE(.MDG,.MDGL) K ^TMP("MDREST",$J)
|
|
..Q
|
|
.I MDX4["TIU" D Q
|
|
..S RESULTS="" D TGET^TIUSRVR1(.RESULTS,+MDX4)
|
|
..D SETLINE(.MDG,.RESULTS) K ^TMP("TIUVIEW",$J)
|
|
..S MDCLIN=MDCLIN+1,@MDG@(MDCLIN,0)=FFF
|
|
..Q
|
|
Q
|
|
SETLINE(MDG,MDGL) ; Set Global Lines
|
|
N MDCK1,MDX3,MDSC,MDNAME,MDTITL,MDDTM
|
|
D NOW^%DTC S X=% D DTIME^MCARP S MDDTM=$$FMTE^XLFDT(X,2) K %
|
|
I $G(MCPRO)'="" S MDNAME=$O(^MCAR(697.2,"B",MCPRO,0)) D
|
|
.I MDNAME S MDTITL=$P($G(^MCAR(697.2,+MDNAME,0)),"^",8)
|
|
.I $G(MDTITL)="" S MDNAME=$O(^MDS(702.01,"B",MCPRO,0)) S:MDNAME MDTITL=$P($G(^MDS(702.01,+MDNAME,0)),U)
|
|
S MDCK1=MDGL,MDSC=$QS(MDCK1,1),MDRPG=MDRPG+1
|
|
I '$G(MDHDR) D
|
|
.Q:MDSC="MDREST"
|
|
.S MDCLIN=MDCLIN+1,@MDG@(MDCLIN,0)="Pg. "_MDRPG_$J(" ",25)_$$HOSP^MDPS2(DFN)_$J(" ",25)_MDDTM
|
|
.I $G(MDTITL)'="" S MDCLIN=MDCLIN+1,@MDG@(MDCLIN,0)=$J(" ",25)_MDTITL
|
|
.S MDCLIN=MDCLIN+1,@MDG@(MDCLIN,0)=$$DEMO^MDPS2(DFN)
|
|
.S MDCLIN=MDCLIN+1,@MDG@(MDCLIN,0)=FFF
|
|
F S MDCK1=$Q(@MDCK1) Q:MDCK1="" Q:$QS(MDCK1,1)'=MDSC Q:$QS(MDGL,2)'=$QS(MDCK1,2) S MDCLIN=MDCLIN+1,@MDG@(MDCLIN,0)=$G(@MDCK1)
|
|
Q
|