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