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

MDPS2.m

Go to the documentation of this file.
  1. MDPS2 ; HOIFO/NCA - CP/Medicine Report Generator (Cont.) ;5/18/04 09:41
  1. ;;1.0;CLINICAL PROCEDURES;**2**;Apr 01, 2004
  1. ; Integration Agreements:
  1. ; Reference IA #2432 for Hospital Location File #44 FM Lookup
  1. ; #1576 for DIVISION file 40.8 lookup
  1. ; #2263 for XPAR Utilities
  1. ; #4231 for Document CKP^GMTSUP usage.
  1. ; #4428 for ORWRP TIME/OCC LIMITS ALL Parameter.
  1. ; #10035 for Patient File (#2) Direct Global Reads
  1. ; #10060 for New Person file (#200) Read w/FM
  1. ; #10061 for ^VADPT call.
  1. ; #10103 for XLFDT calls.
  1. ;
  1. GETDATA(MDGRS,MDDFN,MDPR,MDF,MDR,MDT,MDH) ; Return the text of the Medicine Report
  1. ; Input: MDGRS - Return Global Array (Required)
  1. ; MDDFN - Patient DFN (Required)
  1. ; MDPR - Procedure name in file #697.2 (Required)
  1. ; MDF - File number (Required)
  1. ; MDR - Record number (Required)
  1. ; MDT - The type of report (Full or Caption) (Required)
  1. ; MDH - Header is needed or not (Required)
  1. ;
  1. I '$G(MDDFN)!('$D(MDGRS)) Q
  1. N MDCT,MDDAT,MDERR,MDDRDR,MDFLD,MDFLD1,MDFTYP,MDDS0,MDDS1,MDGPRO,MDL1,MDLAB,MDLNE,MDLP,MDMCT,MDMFLD,MDN,MDNOD,MDNXT,MDPNAM,MDSUBF,MDTX,MDTXT,MDVAL,Y
  1. S MDN=MDT
  1. S MDERR=$$GETDATA^MCORMN1(MDPR,MDR,"^TMP(""MCORMN"",$J)",MDF,$S(MDT'="RD":"RD",1:MDT))
  1. I +MDERR=0 S @MDGRS@(1,0)="No Report Text" Q
  1. S MDGPRO=$O(^MCAR(697.2,"B",MDPR,0)),(MDDS0,MDDS1)=0,MDPNAM=$P($G(^MCAR(697.2,+MDGPRO,0)),U,8) S:MDPNAM="" MDPNAM=MDPR
  1. I MDPR["PFT" S MDLNE=0 D GET^MDPFTP1(.MDGRS,MDF,MDR,MDPNAM,MDLNE,MDH) Q
  1. F S MDDS1=+$O(^MCAR(690.2,"D",MDGPRO,MDDS1)) Q:'MDDS1!(MDDS0) D
  1. .Q:'$D(^MCAR(690.2,MDDS1,0))
  1. .S:$P(^MCAR(690.2,MDDS1,0),U,3)="F" MDDS0=MDDS1
  1. I 'MDDS0 S @MDGRS@(1,0)="No Report Text" Q
  1. S MDFLD="",(MDDRDR,MDLNE)=0,MDNOD=$NA(^TMP("MCORMN",$J)) D HEAD
  1. ; Get the Single in the Medicine View File (#690.2)
  1. F S MDFLD=$O(^MCAR(690.2,MDDS0,1,MDFLD)) Q:MDFLD="" S MDDRDR=+$G(^(MDFLD,0)) D
  1. .Q:'MDDRDR
  1. .S MDDAT=$G(@MDNOD@("F",MDF,MDDRDR,0)),MDLAB=$P(MDDAT,U),MDFTYP=$P(MDDAT,U,2)
  1. .S:MDLAB'="" MDLAB=MDLAB_": "
  1. .I +MDFTYP I $E($P(MDFTYP,+MDFTYP,2),1)?1U D SUBF Q
  1. .I +MDFTYP&($P($G(@MDNOD@("F",+MDFTYP,.01,0)),U,2)["W") D Q
  1. ..I MDT="CD" S MDNXT=$O(@MDNOD@("E",MDF,MDR,MDDRDR,0)) Q:'+MDNXT Q:$G(@MDNOD@("E",MDF,MDR,MDDRDR,+MDNXT))=""
  1. ..D SETNODE(MDGRS," "),SETNODE(MDGRS,MDLAB)
  1. ..S MDLP=0 F S MDLP=$O(@MDNOD@("E",MDF,MDR,MDDRDR,MDLP)) Q:MDLP<1 S MDVAL=" "_$G(^(MDLP)) D SETNODE(MDGRS,MDVAL)
  1. ..D SETNODE(MDGRS," ")
  1. ..Q
  1. .I MDFTYP'["W"&(MDFTYP'["M") D Q
  1. ..S MDTXT=$G(@MDNOD@("E",MDF,MDR,MDDRDR,1))
  1. ..Q:MDT="CD"&(MDTXT="")
  1. ..I MDFTYP["D" S MDTX=$$FMTE^XLFDT(MDTXT,2),MDTXT=MDTX
  1. ..S MDVAL=MDLAB_$S(MDLAB'="":" "_MDTXT,1:"") D SETNODE(MDGRS,MDVAL)
  1. ..Q
  1. .Q
  1. I +$P($G(^MCAR(MDF,MDR,2005,0)),U,4)>0 D
  1. .D SETNODE(MDGRS," ")
  1. .D SETNODE(MDGRS,"NOTE: Images are associated with this procedure.")
  1. .D SETNODE(MDGRS," Please use Imaging Display to view the images.")
  1. .Q
  1. K ^TMP("MCORMN",$J)
  1. D FOOTER
  1. Q
  1. SETNODE(NODE,VALUE) ;Set the node with the string
  1. S MDLNE=MDLNE+1,@NODE@(MDLNE,0)=VALUE
  1. Q
  1. SUBF ; Get the Sub-file fields in the Medicine View File (#690.2)
  1. S MDMFLD=$O(^MCAR(690.2,MDDS0,2,"B",+MDFTYP,0)) Q:'MDMFLD
  1. S MDCT=0,MDMCT=0 F S MDCT=$O(@MDNOD@("E",+MDFTYP,MDCT)) Q:MDCT<1 S MDFLD1=0 F S MDFLD1=$O(@MDNOD@("E",+MDFTYP,MDCT,MDFLD1)) Q:MDFLD1="" D
  1. .S:MDFLD1=".01" MDMCT=MDMCT+1
  1. .Q:'+$O(^MCAR(690.2,MDDS0,2,MDMFLD,1,"B",MDFLD1,0))
  1. .S MDDAT=$G(@MDNOD@("F",+MDFTYP,MDFLD1,0)),MDLAB=$P(MDDAT,U)
  1. .S:MDLAB'="" MDLAB=MDLAB_": "
  1. .I MDT="CD" Q:$G(@MDNOD@("E",+MDFTYP,MDCT,MDFLD1,1))=""
  1. .I $P(MDDAT,U,2)["M" D Q
  1. ..I MDMCT<2 D SETNODE(MDGRS," "),SETNODE(MDGRS,MDLAB)
  1. ..S MDVAL=" "_$G(@MDNOD@("E",+MDFTYP,MDCT,MDFLD1,1)) D SETNODE(MDGRS,MDVAL) Q
  1. .I $P(MDDAT,U,2)["D" S MDVAL=$G(@MDNOD@("E",+MDFTYP,MDCT,MDFLD1,1)),MDTX=$$FMTE^XLFDT(MDVAL,2),MDVAL=MDTX D SETNODE(MDGRS,MDLAB_MDVAL) Q
  1. .S MDVAL=" "_MDLAB_$G(@MDNOD@("E",+MDFTYP,MDCT,MDFLD1,1)) D SETNODE(MDGRS,MDVAL) Q
  1. .Q
  1. Q
  1. Q:+$G(MDH)
  1. N CODE,ERROR,PART,PDUZ,RDATE,SCD,SCRAMBLE,SDUZ,TDATE,TEMP,TRUE,TP,DIC,DR,DA,DIQ
  1. N ENAME,EES,EDATE,NAME,NUM,VNAME,VES,VDATE,CODE,RELDATE,VERDATE,NA,MFD,MFDNAME,SUPD,CREATION,SUPNUM,SUPNUM,SUP1,SUP2,ROV,VERSION
  1. N FT,FTYPE,FNAME,PERSON,DTEMP,TT,X,X1,X2
  1. I '$D(^MCAR(MDF,+MDR,"ES")) Q
  1. S TEMP=$G(^MCAR(MDF,MDR,"ES"))
  1. ; Retrieve RC/ES Field (NA = Dont need)
  1. S NAME="ENAME^NA^EDATE^VNAME^VES^VDATE^CODE^RDATE^VDATE^SUP1^SUP2^MFD^MFDNAME^SUPD^CREATION^SUPNUM",FTYPE="P^X^D^P^F^D^F^D^D^F^F^F^P^D^D^F"
  1. F TT=1:1:16 S Y=$P(TEMP,U,TT),FT=$P(FTYPE,U,TT),FNAME=$P(NAME,U,TT) D DATE:FT="D",NAME:FT="P",FREE:FT="F"
  1. S SCD=$S(MFD:EDATE,CODE["RV":VDATE,CODE["ROV":VDATE,CODE="RNV":RDATE,CODE="S":EDATE,1:EDATE)
  1. S PERSON=$$DECODE(TEMP,CODE,MDF,MDR)
  1. S ROV=$S(CODE["ROV":"Signing for "_VNAME,1:""),SUPNUM=+SUPNUM,TSUP2=SUP2,SUPNUM=SUPNUM+1
  1. S:'SUP2 NUM=SUPNUM
  1. D:SUP2 VERSION
  1. S VERSION=SUPNUM_" of "_NUM,SS=""
  1. S $P(SS," -",40)="" D SETNODE(MDGRS,SS)
  1. S SS=$J(" ",18)_"R e p o r t R e l e a s e S t a t u s" D SETNODE(MDGRS,SS)
  1. D SETNODE(MDGRS," ")
  1. S SS="Current "_$J(" ",11)_"Date "_$J(" ",2)_"Person Who" D SETNODE(MDGRS,SS)
  1. S SS="Report "_$J(" ",11)_$S(CODE["D":"Last ",1:"Status ")_" Last "_$S(CODE["D":"Edited",1:"Changed")
  1. S SS=SS_$J(" ",13)_"Date of"_$J(" ",12)_"Report" D SETNODE(MDGRS,SS) S SS=""
  1. S SS="Status "_$J(" ",11)_$S(CODE["D":"Edited",1:"Changed")_$J(" ",2)_$S(CODE["D":" Procedure",1:"The Status")_$J(" ",15)_" Entry "_$J(" ",12)_"Version" D SETNODE(MDGRS,SS) S SS=""
  1. S $P(SS,"=",80)="" D SETNODE(MDGRS,SS)
  1. I $G(MCSTAT)'="" D SETNODE(MDGRS,MCSTAT)
  1. S SS=$J(" ",19)_SCD_$J(" ",2)_PERSON
  1. S SS=SS_$J(" ",(52-$L(SS)))
  1. S SS=SS_CREATION_$J(" ",(64-$L(SS)))_VERSION
  1. D SETNODE(MDGRS,SS) K SS
  1. D SETNODE(MDGRS,$J(" ",28)_ROV)
  1. K MCFILE1
  1. Q
  1. NAME S Y=$$GET1^DIQ(200,+Y_",",.01,"E"),@FNAME=$P(Y,",",2)_" "_$P(Y,",",1) Q
  1. DATE S @FNAME=+$E(Y,4,5)_"/"_+$E(Y,6,7)_"/"_$E((1700+$E(Y,1,3)),3,4) Q
  1. FREE S @FNAME=Y Q
  1. DECODE(TEMP,CODE,FILE,REC) ;Decode the Validation code 1
  1. N CR,PDUZ,STR,PRE
  1. S PRE=+$P(TEMP,U,1) S:PRE=0 PRE=DUZ
  1. Q:(CODE="")!(CODE="D")!(CODE="PD")!(CODE="MFD")!(CODE="S") $$GET1^DIQ(200,PRE_",",.01) ;HUN-1095-22932
  1. S CR=$P(TEMP,U,$S(CODE["RV":5,1:2))
  1. S PDUZ=$P(TEMP,U,$S(CODE["RV":4,1:1))
  1. S STR=$$SUM^MCESPRT($G(^MCAR(MDF,REC,0)))
  1. Q $$DECODER^MCESPRT(CR,PDUZ,REC)
  1. ;
  1. VERSION ; Find the version number of a procedure
  1. F NUM=SUPNUM:1 D CHECK Q:TSUP2=0
  1. S NUM=NUM+1
  1. Q
  1. CHECK ; Find the number of times the report was superseded
  1. S DTEMP=$G(^MCAR(MDF,TSUP2,"ES"))
  1. S TSUP2=+$P(DTEMP,U,11)
  1. Q
  1. HEDSPAS(MDTX,MDSP1) ; surround text string X with space to length X1
  1. N I,Y1
  1. S (TY,Y1)="",$P(Y1," ",MDSP1-$L(MDTX)\2-1)=" ",TY=Y1_" "_MDTX_" "
  1. F I=$L(TY):1:MDSP1 S TY=TY_" "
  1. Q TY
  1. SET ; Set GMTS variable
  1. N MDLIM1 S MDLIM=GMTSNDM
  1. D:+$G(MDLIM)<1 LIMIT(.MDLIM)
  1. S MDTS2=(9999999-GMTS1),MDTS1=(9999999-GMTS2)
  1. Q
  1. LIMIT(MDLIM) ; Get all Report maximum occurrence limit
  1. N LIM
  1. S LIM=$$GET^XPAR("USR.`"_DUZ_"^DIV^SYS^PKG","ORWRP TIME/OCC LIMITS ALL",1,"I")
  1. S MDLIM=$S(+$P(LIM,";",3):+$P(LIM,";",3),1:999)
  1. Q
  1. N MDPG S MDPG=0
  1. H1 ; Display Header with Page increment
  1. Q:+$G(MDH)
  1. N CODE,MDDOB,MDRB,MDTIME,MDWARD,MDTM,X
  1. S MDPG=MDPG+1 D NOW^%DTC S X=% D DTIME^MCARP S MDTIME=$$FMTE^XLFDT(X,2)
  1. S MCSTAT="",MDTM=$G(^MCAR(MDF,+MDR,"ES")),CODE=$P(MDTM,U,7),MFD=$P(MDTM,U,12) I CODE'="" S MCSTAT=$S(MFD:" Mark for Deletion",1:"X") S:MCSTAT="X" MCSTAT=$$STATUS^MCESEDT(MDF,CODE)
  1. D DEM^VADPT
  1. S SS="Pg. "_MDPG_$J(" ",25)_$$HOSP(DFN)
  1. S SS=SS_$J(" ",(74-$L(SS_MDTIME)))_MDTIME D SETNODE(MDGRS,SS)
  1. S SS=$$HEDSPAS(MDPNAM_" REPORT"_$S(MCSTAT="":"",1:" - "_MCSTAT),77) D SETNODE(MDGRS,SS) S SS=""
  1. S SS=$$DEMO(DFN) D SETNODE(MDGRS,SS)
  1. N FFF S $P(FFF,"- ",40)="- " D SETNODE(MDGRS,FFF)
  1. Q
  1. HOSP(DFN) ; Hospital for Header
  1. N HOSP
  1. S HOSP=$P($G(^DPT(DFN,.1)),U)
  1. S:HOSP'="" HOSP=$$FIND1^DIC(44,,"X",HOSP)
  1. S:HOSP'<1 HOSP=$$GET1^DIQ(44,HOSP,3.5,"I")
  1. S:HOSP'="" HOSP=$P($G(^DG(40.8,HOSP,0)),U)
  1. Q HOSP
  1. DEMO(DFN) ; Demographics for Header
  1. N SS1,MDDOB,MDWARD,SS1
  1. D DEM^VADPT
  1. S SS1=$G(VADM(1))_" "_$P($G(VADM(2)),U,2)_" "
  1. S MDDOB=" DOB: "_$P($G(VADM(3)),U,2)_" ("_$G(VADM(4))_")"
  1. S SS1=SS1_$J(" ",(39-$L(MDDOB)))_MDDOB
  1. D KVAR^VADPT
  1. D INP^VADPT S MDWARD=$S(VAIN(4)'="":$P(VAIN(4),U,2),1:"NOT INPATIENT"),MDRB=VAIN(5) D KVAR^VADPT
  1. Q SS1_$J(" ",(72-$L(SS1)))_MDWARD_" "_MDRB
  1. HDR ; Page Header
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W " CONSULT DATE/TIME",!
  1. D CKP^GMTSUP Q:$D(GMTSQIT)
  1. W " NUMBER COMPLETED PROCEDURES PERFORMED PROCEDURE CODE",!
  1. D CKP^GMTSUP Q:$D(GMTSQIT)
  1. W " ------- ------------------------------ ---------------- -----------------",!
  1. Q
  1. HSHDR ; Health Summary One Line Procedure Header
  1. N MDLINE
  1. S $P(MDLINE,"-",80)=""
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W !,MDLINE
  1. 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),?64,$P(MDX1,U,7)
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W !,MDLINE
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W !
  1. Q