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