Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MDPS1

MDPS1.m

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