MDPSU ; HOIFO/NCA - CP/Medicine Report Generator Utility;5/18/04 09:48
;;1.0;CLINICAL PROCEDURES;**21**;Apr 01, 2004;Build 30
; 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# 4231 [Subscription] Document CKP^GMTSUP usage.
; IA# 4792 [Private] CANDO^TIUSRVA call
; IA# 10017 [Supported] ^DD("DD")
; IA# 10103 [Supported] Routine XLFDT 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
N MDIAR,MDIL Q:'$G(MDC)
F MDIL=0:0 S MDIL=$O(^MDS(702.01,"AINST",+MDC,MDIL)) Q:MDIL<1 S MDIAR(MDIL)=MDC
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
.I $G(MDC)'="" Q:$G(MDIAR($P(MDX,"^",4)))'=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=$$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,MDIAR
Q
CPF ; Full Report - Health Summary Component
N MDHR,MDHSG,MDHDR,MDHFLG,MDLIM,MDRTN,MDT,MDTS1,MDTS2,MDX1
Q:'$G(DFN) Q:'$G(GMTS1) Q:'$G(GMTS2)
Q:$G(GMTSEGH)="" S MDRTN=$P(GMTSEGH," -") Q:MDRTN="" S MDRTN=+$P(MDRTN,"M",2) Q:'MDRTN
K ^TMP("MDHSP",$J) S MDHFLG=1
S MDHSG=$NA(^TMP("MDHSP",$J)) D SET^MDPS2
D EN1(.MDHSG,DFN,MDTS1,MDTS2,MDLIM,MDRTN)
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
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")
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(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 MDXY=$$GET^XPAR("SYS","MD GET HIGH VOLUME",MDAK,"E")
.K ^TMP("MDGMRC",$J),^TMP("GMRCR",$J,"DT")
.I '+$P(MDXY,";",2) S RESULTS=$NA(^TMP("MDGMRC",$J)) D RT^GMRCGUIA(MDCON,.RESULTS)
.I +$P(MDXY,";",2) S RESULTS=$NA(^TMP("GMRCR",$J,"DT")) D DT^GMRCSLM2(MDCON)
.D SETLINE(.MDG,.RESULTS) K ^TMP("MDGMRC",$J),^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)) 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[HMDPSU 9046 printed Dec 13, 2024@01:43:55 Page 2
MDPSU ; HOIFO/NCA - CP/Medicine Report Generator Utility;5/18/04 09:48
+1 ;;1.0;CLINICAL PROCEDURES;**21**;Apr 01, 2004;Build 30
+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# 4231 [Subscription] Document CKP^GMTSUP usage.
+10 ; IA# 4792 [Private] CANDO^TIUSRVA call
+11 ; IA# 10017 [Supported] ^DD("DD")
+12 ; IA# 10103 [Supported] Routine XLFDT calls
+13 ;
+14 ; Pre-existing local variables
+15 ; DFN,GMTS1,GMTS2,GMTSNDM,GMTSNPG,GMTSQIT
+16 ;
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 ;D:$G(MDC)="" GP^MDPS4(MDDFN,MDSDT,MDEDT)
+19 ;I '$G(MDSDT),'$G(MDEDT) D EN^MDARP3(MDDFN,MDC)
+20 ;E D 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 NEW MDIAR,MDIL
if '$GET(MDC)
QUIT
+2 FOR MDIL=0:0
SET MDIL=$ORDER(^MDS(702.01,"AINST",+MDC,MDIL))
if MDIL<1
QUIT
SET MDIAR(MDIL)=MDC
+3 SET MDLP=""
FOR
SET MDLP=$ORDER(^MDD(702,"B",MDDFN,MDLP))
if MDLP<1
QUIT
Begin DoDot:1
+4 SET MDX=$GET(^MDD(702,MDLP,0))
if $PIECE(MDX,"^",9)'=3
QUIT
+5 SET MDPROC=$$GET1^DIQ(702,MDLP_",",.04,"E")
if MDPROC=""
QUIT
+6 if '$PIECE(MDX,U,6)
QUIT
+7 KILL ^TMP("MDTIUST",$JOB)
SET MDTIUER=""
+8 DO EXTRACT^TIULQ($PIECE(MDX,U,6),"^TMP(""MDTIUST"",$J)",MDTIUER,".01;.05;70201;70202")
if +MDTIUER
QUIT
+9 IF $GET(MDC)'=""
if $GET(MDIAR($PIECE(MDX,"^",4)))'=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 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,MDIAR
+35 QUIT
CPF ; Full Report - Health Summary Component
+1 NEW MDHR,MDHSG,MDHDR,MDHFLG,MDLIM,MDRTN,MDT,MDTS1,MDTS2,MDX1
+2 if '$GET(DFN)
QUIT
if '$GET(GMTS1)
QUIT
if '$GET(GMTS2)
QUIT
+3 if $GET(GMTSEGH)=""
QUIT
SET MDRTN=$PIECE(GMTSEGH," -")
if MDRTN=""
QUIT
SET MDRTN=+$PIECE(MDRTN,"M",2)
if 'MDRTN
QUIT
+4 KILL ^TMP("MDHSP",$JOB)
SET MDHFLG=1
+5 SET MDHSG=$NAME(^TMP("MDHSP",$JOB))
DO SET^MDPS2
+6 DO EN1(.MDHSG,DFN,MDTS1,MDTS2,MDLIM,MDRTN)
+7 IF '$DATA(^TMP("MDHSP",$JOB))
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE !,"No Procedure Data for the patient."
QUIT
+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 HSHDR^MDPS2
+10 SET MCARGDA=+$PIECE(MDX1,U,2)
SET MCPRO=$PIECE(MDX1,U,11)
SET MCARPPS=$PIECE(MDX1,U,3,4)
+11 SET MCARGRTN=$PIECE(MDX1,U,5)
SET MDT=$SELECT($GET(MDT1)="":"RD",1:"CD")
SET MDHDR=1
+12 DO @MCARPPS
QUIT
End DoDot:1
+13 KILL ^TMP("MDHSP",$JOB),MCARGDA,MCARGRTN,MCPRO,MCARPPS,MDT1
+14 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
+3 IF '$GET(MDALL)
KILL ^TMP("MDPTXT",$JOB)
+4 SET MDIMG=0
SET $PIECE(FFF,"-",80)=""
SET MDRPG=0
+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 MDXY=$$GET^XPAR("SYS","MD GET HIGH VOLUME",MDAK,"E")
+20 KILL ^TMP("MDGMRC",$JOB),^TMP("GMRCR",$JOB,"DT")
+21 IF '+$PIECE(MDXY,";",2)
SET RESULTS=$NAME(^TMP("MDGMRC",$JOB))
DO RT^GMRCGUIA(MDCON,.RESULTS)
+22 IF +$PIECE(MDXY,";",2)
SET RESULTS=$NAME(^TMP("GMRCR",$JOB,"DT"))
DO DT^GMRCSLM2(MDCON)
+23 DO SETLINE(.MDG,.RESULTS)
KILL ^TMP("MDGMRC",$JOB),^TMP("GMRCR",$JOB,"DT")
End DoDot:1
if +$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))
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
