MDRPCW1 ; HOIFO/NCA - MD TMDENCOUNTER Object ;2/16/10 16:17
;;1.0;CLINICAL PROCEDURES;**6,21,20,29**;Apr 01, 2004;Build 22
; Reference Integration Agreement:
; IA #1573 [Supported] ICDONE^LEXU call
; IA #1593 [Subscription] Access to Provider Narrative file
; (#9999999.27)
; IA #1609 [Supported] CONFIG^LEXSET call
; IA #1894 [Subscription] PXAPI calls
; IA #1995 [Supported] ICPTCOD calls
; IA #2056 [Supported] Call to DIQ
; IA #2263 [Supported] XPAR calls
; IA #2348 [Subscription] SCCOND^PXUTLSCC call
; IA #2950 [Supported] LOOK^LEXA call
; IA #5699 [Supported] ICDDATA^ICDXCODE calls
; IA #10060 [Supported] FILE 200 references
; IA #5747 [Supported] $$SINFO^ICDEX
;
CPTMODS(RESULTS,MDCPT) ;Return CPT Modifiers for a CPT Code
N MDARR,MDIDX,MDI,MDNAME
S RESULTS=$NA(^TMP("MDMODS",$J)) K @RESULTS
S MDDATE=DT
I +($$CODM^ICPTCOD(MDCPT,$NA(MDARR),0,MDDATE)),+$D(MDARR) D
. S MDIDX="",MDI=0
. F S MDIDX=$O(MDARR(MDIDX)) Q:(MDIDX="") D
. . S MDI=MDI+1,MDNAME=$P(MDARR(MDIDX),U,1)
. . S @RESULTS@(MDNAME_MDI)=$P(MDARR(MDIDX),U,2)_U_MDNAME_U_MDIDX
Q
LEX(RESULTS,MDSRCH,MDAPP,STUDY) ; return list after lexicon lookup
N CODE,LEX,MDLST,MDI,LEXIEN,MDVAL
S RESULTS=$NA(^TMP("MDLEX",$J)) K @RESULTS
Q:'$G(STUDY)
Q:'$G(^MDD(702,+STUDY,0))
S MDDATE=$P($P($P(^MDD(702,STUDY,0),"^",7),";",2),".",1)
S:MDAPP="CPT" MDAPP="CHP" ; LEX PATCH 10
K ^TMP("LEXSCH",$J)
I MDAPP="ICD" S MDAPP=$P($$SINFO^ICDEX("DIAG",MDDATE),"^",3)
D CONFIG^LEXSET(MDAPP,MDAPP,MDDATE)
D LOOK^LEXA(MDSRCH,MDAPP,1,"",MDDATE)
I '$D(LEX("LIST",1)) S @RESULTS@(1)="-1^No matches found." Q
S @RESULTS@(1)=LEX("LIST",1),MDLST=1
S MDI="" F S MDI=$O(^TMP("LEXFND",$J,MDI)) Q:MDI'<0 D
. S LEXIEN=$O(^TMP("LEXFND",$J,MDI,0))
. S MDLST=MDLST+1,@RESULTS@(MDLST)=LEXIEN_U_^TMP("LEXFND",$J,MDI,LEXIEN)
K ^TMP("LEXFND",$J),^TMP("LEXHIT",$J)
S MDI="" F S MDI=$O(@RESULTS@(MDI)) Q:'MDI S MDVAL=$G(@RESULTS@(MDI)) D
. I MDAPP="ICD"!(MDAPP="10D") S CODE=$$ONE^LEXU(+MDVAL,MDDATE,MDAPP),@RESULTS@(MDI)=CODE_U_MDVAL
. I MDAPP="CPT"!(MDAPP="CHP") S CODE=$$CPTONE^LEXU(+MDVAL,MDDATE),@RESULTS@(MDI)=CODE_U_MDVAL
. I CODE="",(MDAPP="CHP") S CODE=$$CPCONE^LEXU(+MDVAL,MDDATE),@RESULTS@(MDI)=CODE_U_MDVAL
Q
GETENC(RESULTS,STUDY) ; Return the current encounter data entered
S RESULTS=$NA(^TMP("MDENC",$J)) K @RESULTS
N MDDAR,MDDAR2,CAT,CODE,DIAG,GLOARR,MDCCON,MDX802,MDARR,MDCPT,MDCTR,MDDFN,MDENCDT,MDFLST,MDICD,MDLC,MDLL,MDLOCN,MDPROV,MDRP,MDRST,MDVST,MDVSTR,QTY,MDX,MDX0,MDX1,S S S=";"
N GDIAG,LLB,MDDDN,MDDDV,MDCK,RESLT,MDNCTR,MDPFLG,MDCLL,MDDESC S (MDCK,MDPFLG)=0
Q:'$G(STUDY)
Q:'$G(^MDD(702,+STUDY,0))
D NOW^%DTC S MDDEF=% K % S MDCTR=0
K ^TMP("MDDAR",$J),^TMP("MDLEX",$J),GLOARR,MDFLST
S MDX=$G(^MDD(702,+STUDY,0)),MDX1=$G(^(1)),MDCCON=$P(MDX,U,5)
S MDVST=$P(MDX1,U),MDDFN=$P(MDX,U) Q:'MDDFN
S:+MDVST MDPFLG=1
S MDVSTR=$P(MDX,U,7),MDDAR=$NA(^TMP("MDDAR",$J)),MDDAR2=$NA(GLOARR),@MDDAR2@("POV",0)=0,@MDDAR2@("CPT",0)=0,MDLC=0
I 'MDVST S MDRP=0 F S MDRP=$O(^MDD(702,STUDY,.1,MDRP)) Q:'MDRP D
.S MDRST=$P($G(^MDD(702,STUDY,.1,+MDRP,0)),"^",3)
.I +MDRST D CICNV^MDHL7U3(+MDRST,.MDDAR) D SETGLO(.MDDAR,.MDDAR2)
.K ^TMP("MDDAR",$J) Q
I 'MDVST&(+$G(@MDDAR2@("POV",0))>0) F MDLL=1:1:+$G(@MDDAR2@("POV",0)) S MDLC=MDLC+1,MDFLST(MDLC)=$G(@MDDAR2@("POV",MDLL))
I 'MDVST&(+$G(@MDDAR2@("CPT",0))>0) F MDLL=1:1:+$G(@MDDAR2@("CPT",0)) S MDLC=MDLC+1,MDFLST(MDLC)=$G(@MDDAR2@("CPT",MDLL))
I MDVST>0 S MDENCDT=$P(MDVSTR,";",2),MDLOCN=$P(MDVSTR,";",3)
;E S MDENCDT=$$PDT^MDRPCOT1(STUDY)
E S MDENCDT=$P(MDVSTR,";",2)
S:$L(MDVSTR,";")=1 MDVSTR=";"_MDVSTR
S MDVSTR=$$GETVSTR^MDRPCOT1(MDDFN,MDVSTR,+$P(MDX,U,4),$P(MDX,U,2)),MDLOCN=$P(MDVSTR,";",1)
S:'MDENCDT MDENCDT=$P(MDVSTR,";",2)
S:'MDENCDT MDENCDT=MDDEF
S:'MDLOCN MDLOCN=$P(MDVSTR,";")
D SCCOND^PXUTLSCC(MDDFN,MDENCDT,MDLOCN,MDVST,.MDARR)
S MDCTR=MDCTR+1
; ^TMP("MDENC",$J,n)="SC";0/1^0/1;"AO";0/1^0/1;"IR";0/1^0/1;"EC";0/1^0/1;"MST";0/1^0/1;"HNC";0/1^0/1;"CV";0/1^0/1
;first piece 1 if the condition can be answered
; 0 if the condition should be null not asked
;second piece - If Scheduling has the answer, 1 = yes 0 = no
S @RESULTS@(MDCTR)="SC"_S_$G(MDARR("SC"))_S_"AO"_S_$G(MDARR("AO"))_S_"IR"_S_$G(MDARR("IR"))_S_"EC"_S_$G(MDARR("EC"))_S_"MST"_S_$G(MDARR("MST"))_S_"HNC"_S_$G(MDARR("HNC"))_S_"CV"_S_$G(MDARR("CV"))
I 'MDVST S MDVST=$$GETENC^PXAPI(MDDFN,MDENCDT,MDLOCN),MDVST=$S(+MDVST<1:0,1:+MDVST)
I +MDVST>0 D ENCEVENT^PXAPI(MDVST)
;^TMP("MDENC",$J,n)="PRV"^CODE^^NARR^^Primary (1=Yes,0=No)
I +MDVST>0 S MDPROV=0 F S MDPROV=$O(^TMP("PXKENC",$J,MDVST,"PRV",MDPROV)) Q:'MDPROV D
.S MDX0=$G(^TMP("PXKENC",$J,MDVST,"PRV",MDPROV,0))
.S CODE=+$P(MDX0,U)
.I +CODE S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="PRV"_U_CODE_U_U_$$GET1^DIQ(200,+CODE_",",.01,"E")_U_U_($P(MDX0,U,4)="P")
;^TMP("MDENC",$J,n)="POV"^ICD9 IEN^ICD9 CODE^provider narrative category^provider narrative (Short Description)^Primary (1=Yes,0=No)
I +MDVST>0 S MDICD=0 F S MDICD=$O(^TMP("PXKENC",$J,MDVST,"POV",MDICD)) Q:'MDICD D
.S MDX0=$G(^TMP("PXKENC",$J,MDVST,"POV",MDICD,0)),MDX802=$G(^(802))
.S CODE=+$G(MDX0,U),GDIAG=$$ICDDATA^ICDXCODE(80,CODE,MDENCDT)
.S:CODE DIAG=$P(GDIAG,U,2)_U_$P(GDIAG,U,4)
.S CAT=$P(MDX802,U)
.S:CAT CAT=$P($G(^AUTNPOV(CAT,0)),U)
.S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="POV"_U_+$G(MDX0,U)_U_$P(DIAG,U)_U_CAT_U_$P(DIAG,U,2)_U_($P(MDX0,U,12)="P"),MDCK=MDCK+1
;^TMP("MDENC",$J,n)="CPT"^CPT IEN^CPT CODE^provider narrative category^provider narrative (Description)^^Quantity
I +MDVST>0 S MDCPT=0 F S MDCPT=$O(^TMP("PXKENC",$J,MDVST,"CPT",MDCPT)) Q:'MDCPT D
.S MDX0=$G(^TMP("PXKENC",$J,MDVST,"CPT",MDCPT,0)),MDX802=$G(^(802))
.S CODE=+$G(MDX0,U)
.S:CODE CODE=$$CPT^ICPTCOD(CODE,MDVST)
.S:CODE DIAG=$P(CODE,U,2,3)
.S CAT=$P(MDX802,U)
.S:CAT CAT=$P($G(^AUTNPOV(CAT,0)),U)
.S QTY=$P(MDX0,U,16)
.S MDDESC="" D CPTLEX^MDRPCWU(.RESLT,$P(DIAG,U),"CPT")
.S MDCLL="" F S MDCLL=$O(^TMP("MDLEX",$J,MDCLL)) Q:MDCLL<1 S MDDESC=$P(^(MDCLL),"^",3)
.S:$L(MDDESC)>230 MDDESC=$E(MDDESC,1,230) K ^TMP("MDLEX",$J),RESLT
.S:MDDESC="" MDDESC=$P(DIAG,U,2)
.S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="CPT"_U_+$G(MDX0,U)_U_$P(DIAG,U)_U_CAT_U_MDDESC_U_U_QTY,MDCK=MDCK+1
K ^TMP("PXKENC",$J)
I 'MDVST!(+MDCK<1) D
.S MDDDN=$O(^MDD(702,"ACON",MDCCON,+STUDY),-1),MDVST=0
.I MDDDN D
..S MDDDV=$P($G(^MDD(702,+MDDDN,0)),U,7)
..S:$L(MDDDV,";")>1 MDENCDT=$P(MDDDV,";",2),MDVST=+$G(^MDD(702,+MDDDN,1)),MDVST=$S(+MDVST<1:0,1:+MDVST)
..I +MDVST>0 S MDNCTR=MDCTR F LLB=2:1:MDCTR K @RESULTS@(MDCTR) S MDNCTR=MDNCTR-1
I $G(MDFLST(1))'="" S MDLL=0 F S MDLL=$O(MDFLST(MDLL)) Q:MDLL<1 S:$G(MDFLST(MDLL))'="" MDCTR=MDCTR+1,@RESULTS@(MDCTR)=$G(MDFLST(MDLL))
Q:MDCK>0
Q:'MDVST
D ENCEVENT^PXAPI(MDVST) S:$G(MDNCTR)>0 MDCTR=MDNCTR
;^TMP("MDENC",$J,n)="PRV"^CODE^^NARR^^Primary (1=Yes,0=No)
S MDPROV=0 F S MDPROV=$O(^TMP("PXKENC",$J,MDVST,"PRV",MDPROV)) Q:'MDPROV D
.Q
.S MDX0=$G(^TMP("PXKENC",$J,MDVST,"PRV",MDPROV,0))
.S CODE=+$P(MDX0,U)
.I +CODE S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="PRV"_U_CODE_U_U_$$GET1^DIQ(200,+CODE_",",.01,"E")_U_U_($P(MDX0,U,4)="P")
;^TMP("MDENC",$J,n)="POV"^ICD9 IEN^ICD9 CODE^provider narrative category^provider narrative (Short Description)^Primary (1=Yes,0=No)
S MDICD=0 F S MDICD=$O(^TMP("PXKENC",$J,MDVST,"POV",MDICD)) Q:'MDICD D
.S MDX0=$G(^TMP("PXKENC",$J,MDVST,"POV",MDICD,0)),MDX802=$G(^(802))
.S CODE=+$G(MDX0,U),GDIAG=$$ICDDATA^ICDXCODE(80,CODE,MDENCDT)
.S:CODE DIAG=$P(GDIAG,U,2)_U_$P(GDIAG,U,4)
.S CAT=$P(MDX802,U)
.S:CAT CAT=$P($G(^AUTNPOV(CAT,0)),U)
.S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="POV"_U_+$G(MDX0,U)_U_$P(DIAG,U)_U_CAT_U_$P(DIAG,U,2)_U_($P(MDX0,U,12)="P")
;^TMP("MDENC",$J,n)="CPT"^CPT IEN^CPT CODE^provider narrative category^provider narrative (Short Description)^^Quantity
S MDCPT=0 F S MDCPT=$O(^TMP("PXKENC",$J,MDVST,"CPT",MDCPT)) Q:'MDCPT D
.S MDX0=$G(^TMP("PXKENC",$J,MDVST,"CPT",MDCPT,0)),MDX802=$G(^(802))
.S CODE=+$G(MDX0,U)
.S:CODE CODE=$$CPT^ICPTCOD(CODE,MDVST)
.S:CODE DIAG=$P(CODE,U,2,3)
.S CAT=$P(MDX802,U)
.S:CAT CAT=$P($G(^AUTNPOV(CAT,0)),U)
.S QTY=$P(MDX0,U,16)
.S MDDESC="" D CPTLEX^MDRPCWU(.RESLT,$P(DIAG,U),"CPT")
.S MDCLL="" F S MDCLL=$O(^TMP("MDLEX",$J,MDCLL)) Q:MDCLL<1 S MDDESC=$P(^(MDCLL),"^",3)
.S:$L(MDDESC)>230 MDDESC=$E(MDDESC,1,230) K ^TMP("MDLEX",$J),RESLT
.S:MDDESC="" MDDESC=$P(DIAG,U,2)
.S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="CPT"_U_+$G(MDX0,U)_U_$P(DIAG,U)_U_CAT_U_MDDESC_U_U_QTY
K ^TMP("PXKENC",$J)
Q
SETGLO(MDGLO1,MDGLO2) ; Set the ICD and CPT from device into a global array
N MDA,MDB,MDC
I +$G(@MDGLO1@(1))<1&(+$G(@MDGLO1@(2))<1) Q
S MDA=$O(@MDGLO2@("POV",""),-1)
S MDB=$O(@MDGLO2@("CPT",""),-1)
F MDC=1:1:+$G(@MDGLO1@(1)) S MDA=MDA+1,@MDGLO2@("POV",MDA)=$G(@MDGLO1@(1,MDC))
F MDC=1:1:+$G(@MDGLO1@(2)) S MDB=MDB+1,@MDGLO2@("CPT",MDB)=$G(@MDGLO1@(2,MDC))
S @MDGLO2@("POV",0)=MDA,@MDGLO2@("CPT",0)=MDB
Q
NTIU(P1,RECID) ; Create New TIU note for Result
I $G(^MDD(702,+P1,0))="" Q 0
N MDNEWN,MDFG,MDHVL,MDKK S MDFG=0
D GETLST^XPAR(.MDHVL,"SYS","MD GET HIGH VOLUME")
F MDKK=0:0 S MDKK=$O(MDHVL(MDKK)) Q:MDKK<1 I $P($G(MDHVL(MDKK)),"^")=+$P(^MDD(702,+P1,0),U,4) S MDFG=1 Q
I $P($G(^MDS(702.01,+$P(^MDD(702,+P1,0),U,4),0)),U,6)=2 S MDNEWN=$$NEWTIUN^MDRPCOT2(+P1)
I +$P($G(^MDS(702.01,+$P(^MDD(702,+P1,0),U,4),0)),U,10)!(+MDFG) S MDNEWN=$$NEWTIUN^MDRPCOTH(+P1,RECID)
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDRPCW1 9432 printed Oct 16, 2024@17:45:07 Page 2
MDRPCW1 ; HOIFO/NCA - MD TMDENCOUNTER Object ;2/16/10 16:17
+1 ;;1.0;CLINICAL PROCEDURES;**6,21,20,29**;Apr 01, 2004;Build 22
+2 ; Reference Integration Agreement:
+3 ; IA #1573 [Supported] ICDONE^LEXU call
+4 ; IA #1593 [Subscription] Access to Provider Narrative file
+5 ; (#9999999.27)
+6 ; IA #1609 [Supported] CONFIG^LEXSET call
+7 ; IA #1894 [Subscription] PXAPI calls
+8 ; IA #1995 [Supported] ICPTCOD calls
+9 ; IA #2056 [Supported] Call to DIQ
+10 ; IA #2263 [Supported] XPAR calls
+11 ; IA #2348 [Subscription] SCCOND^PXUTLSCC call
+12 ; IA #2950 [Supported] LOOK^LEXA call
+13 ; IA #5699 [Supported] ICDDATA^ICDXCODE calls
+14 ; IA #10060 [Supported] FILE 200 references
+15 ; IA #5747 [Supported] $$SINFO^ICDEX
+16 ;
CPTMODS(RESULTS,MDCPT) ;Return CPT Modifiers for a CPT Code
+1 NEW MDARR,MDIDX,MDI,MDNAME
+2 SET RESULTS=$NAME(^TMP("MDMODS",$JOB))
KILL @RESULTS
+3 SET MDDATE=DT
+4 IF +($$CODM^ICPTCOD(MDCPT,$NAME(MDARR),0,MDDATE))
IF +$DATA(MDARR)
Begin DoDot:1
+5 SET MDIDX=""
SET MDI=0
+6 FOR
SET MDIDX=$ORDER(MDARR(MDIDX))
if (MDIDX="")
QUIT
Begin DoDot:2
+7 SET MDI=MDI+1
SET MDNAME=$PIECE(MDARR(MDIDX),U,1)
+8 SET @RESULTS@(MDNAME_MDI)=$PIECE(MDARR(MDIDX),U,2)_U_MDNAME_U_MDIDX
End DoDot:2
End DoDot:1
+9 QUIT
LEX(RESULTS,MDSRCH,MDAPP,STUDY) ; return list after lexicon lookup
+1 NEW CODE,LEX,MDLST,MDI,LEXIEN,MDVAL
+2 SET RESULTS=$NAME(^TMP("MDLEX",$JOB))
KILL @RESULTS
+3 if '$GET(STUDY)
QUIT
+4 if '$GET(^MDD(702,+STUDY,0))
QUIT
+5 SET MDDATE=$PIECE($PIECE($PIECE(^MDD(702,STUDY,0),"^",7),";",2),".",1)
+6 ; LEX PATCH 10
if MDAPP="CPT"
SET MDAPP="CHP"
+7 KILL ^TMP("LEXSCH",$JOB)
+8 IF MDAPP="ICD"
SET MDAPP=$PIECE($$SINFO^ICDEX("DIAG",MDDATE),"^",3)
+9 DO CONFIG^LEXSET(MDAPP,MDAPP,MDDATE)
+10 DO LOOK^LEXA(MDSRCH,MDAPP,1,"",MDDATE)
+11 IF '$DATA(LEX("LIST",1))
SET @RESULTS@(1)="-1^No matches found."
QUIT
+12 SET @RESULTS@(1)=LEX("LIST",1)
SET MDLST=1
+13 SET MDI=""
FOR
SET MDI=$ORDER(^TMP("LEXFND",$JOB,MDI))
if MDI'<0
QUIT
Begin DoDot:1
+14 SET LEXIEN=$ORDER(^TMP("LEXFND",$JOB,MDI,0))
+15 SET MDLST=MDLST+1
SET @RESULTS@(MDLST)=LEXIEN_U_^TMP("LEXFND",$JOB,MDI,LEXIEN)
End DoDot:1
+16 KILL ^TMP("LEXFND",$JOB),^TMP("LEXHIT",$JOB)
+17 SET MDI=""
FOR
SET MDI=$ORDER(@RESULTS@(MDI))
if 'MDI
QUIT
SET MDVAL=$GET(@RESULTS@(MDI))
Begin DoDot:1
+18 IF MDAPP="ICD"!(MDAPP="10D")
SET CODE=$$ONE^LEXU(+MDVAL,MDDATE,MDAPP)
SET @RESULTS@(MDI)=CODE_U_MDVAL
+19 IF MDAPP="CPT"!(MDAPP="CHP")
SET CODE=$$CPTONE^LEXU(+MDVAL,MDDATE)
SET @RESULTS@(MDI)=CODE_U_MDVAL
+20 IF CODE=""
IF (MDAPP="CHP")
SET CODE=$$CPCONE^LEXU(+MDVAL,MDDATE)
SET @RESULTS@(MDI)=CODE_U_MDVAL
End DoDot:1
+21 QUIT
GETENC(RESULTS,STUDY) ; Return the current encounter data entered
+1 SET RESULTS=$NAME(^TMP("MDENC",$JOB))
KILL @RESULTS
+2 NEW MDDAR,MDDAR2,CAT,CODE,DIAG,GLOARR,MDCCON,MDX802,MDARR,MDCPT,MDCTR,MDDFN,MDENCDT,MDFLST,MDICD,MDLC,MDLL,MDLOCN,MDPROV,MDRP,MDRST,MDVST,MDVSTR,QTY,MDX,MDX0,MDX1,S
SET S=";"
+3 NEW GDIAG,LLB,MDDDN,MDDDV,MDCK,RESLT,MDNCTR,MDPFLG,MDCLL,MDDESC
SET (MDCK,MDPFLG)=0
+4 if '$GET(STUDY)
QUIT
+5 if '$GET(^MDD(702,+STUDY,0))
QUIT
+6 DO NOW^%DTC
SET MDDEF=%
KILL %
SET MDCTR=0
+7 KILL ^TMP("MDDAR",$JOB),^TMP("MDLEX",$JOB),GLOARR,MDFLST
+8 SET MDX=$GET(^MDD(702,+STUDY,0))
SET MDX1=$GET(^(1))
SET MDCCON=$PIECE(MDX,U,5)
+9 SET MDVST=$PIECE(MDX1,U)
SET MDDFN=$PIECE(MDX,U)
if 'MDDFN
QUIT
+10 if +MDVST
SET MDPFLG=1
+11 SET MDVSTR=$PIECE(MDX,U,7)
SET MDDAR=$NAME(^TMP("MDDAR",$JOB))
SET MDDAR2=$NAME(GLOARR)
SET @MDDAR2@("POV",0)=0
SET @MDDAR2@("CPT",0)=0
SET MDLC=0
+12 IF 'MDVST
SET MDRP=0
FOR
SET MDRP=$ORDER(^MDD(702,STUDY,.1,MDRP))
if 'MDRP
QUIT
Begin DoDot:1
+13 SET MDRST=$PIECE($GET(^MDD(702,STUDY,.1,+MDRP,0)),"^",3)
+14 IF +MDRST
DO CICNV^MDHL7U3(+MDRST,.MDDAR)
DO SETGLO(.MDDAR,.MDDAR2)
+15 KILL ^TMP("MDDAR",$JOB)
QUIT
End DoDot:1
+16 IF 'MDVST&(+$GET(@MDDAR2@("POV",0))>0)
FOR MDLL=1:1:+$GET(@MDDAR2@("POV",0))
SET MDLC=MDLC+1
SET MDFLST(MDLC)=$GET(@MDDAR2@("POV",MDLL))
+17 IF 'MDVST&(+$GET(@MDDAR2@("CPT",0))>0)
FOR MDLL=1:1:+$GET(@MDDAR2@("CPT",0))
SET MDLC=MDLC+1
SET MDFLST(MDLC)=$GET(@MDDAR2@("CPT",MDLL))
+18 IF MDVST>0
SET MDENCDT=$PIECE(MDVSTR,";",2)
SET MDLOCN=$PIECE(MDVSTR,";",3)
+19 ;E S MDENCDT=$$PDT^MDRPCOT1(STUDY)
+20 IF '$TEST
SET MDENCDT=$PIECE(MDVSTR,";",2)
+21 if $LENGTH(MDVSTR,";")=1
SET MDVSTR=";"_MDVSTR
+22 SET MDVSTR=$$GETVSTR^MDRPCOT1(MDDFN,MDVSTR,+$PIECE(MDX,U,4),$PIECE(MDX,U,2))
SET MDLOCN=$PIECE(MDVSTR,";",1)
+23 if 'MDENCDT
SET MDENCDT=$PIECE(MDVSTR,";",2)
+24 if 'MDENCDT
SET MDENCDT=MDDEF
+25 if 'MDLOCN
SET MDLOCN=$PIECE(MDVSTR,";")
+26 DO SCCOND^PXUTLSCC(MDDFN,MDENCDT,MDLOCN,MDVST,.MDARR)
+27 SET MDCTR=MDCTR+1
+28 ; ^TMP("MDENC",$J,n)="SC";0/1^0/1;"AO";0/1^0/1;"IR";0/1^0/1;"EC";0/1^0/1;"MST";0/1^0/1;"HNC";0/1^0/1;"CV";0/1^0/1
+29 ;first piece 1 if the condition can be answered
+30 ; 0 if the condition should be null not asked
+31 ;second piece - If Scheduling has the answer, 1 = yes 0 = no
+32 SET @RESULTS@(MDCTR)="SC"_S_$GET(MDARR("SC"))_S_"AO"_S_$GET(MDARR("AO"))_S_"IR"_S_$GET(MDARR("IR"))_S_"EC"_S_$GET(MDARR("EC"))_S_"MST"_S_$GET(MDARR("MST"))_S_"HNC"_S_$GET(MDARR("HNC"))_S_"CV"_S_$GET(MDARR("CV"))
+33 IF 'MDVST
SET MDVST=$$GETENC^PXAPI(MDDFN,MDENCDT,MDLOCN)
SET MDVST=$SELECT(+MDVST<1:0,1:+MDVST)
+34 IF +MDVST>0
DO ENCEVENT^PXAPI(MDVST)
+35 ;^TMP("MDENC",$J,n)="PRV"^CODE^^NARR^^Primary (1=Yes,0=No)
+36 IF +MDVST>0
SET MDPROV=0
FOR
SET MDPROV=$ORDER(^TMP("PXKENC",$JOB,MDVST,"PRV",MDPROV))
if 'MDPROV
QUIT
Begin DoDot:1
+37 SET MDX0=$GET(^TMP("PXKENC",$JOB,MDVST,"PRV",MDPROV,0))
+38 SET CODE=+$PIECE(MDX0,U)
+39 IF +CODE
SET MDCTR=MDCTR+1
SET @RESULTS@(MDCTR)="PRV"_U_CODE_U_U_$$GET1^DIQ(200,+CODE_",",.01,"E")_U_U_($PIECE(MDX0,U,4)="P")
End DoDot:1
+40 ;^TMP("MDENC",$J,n)="POV"^ICD9 IEN^ICD9 CODE^provider narrative category^provider narrative (Short Description)^Primary (1=Yes,0=No)
+41 IF +MDVST>0
SET MDICD=0
FOR
SET MDICD=$ORDER(^TMP("PXKENC",$JOB,MDVST,"POV",MDICD))
if 'MDICD
QUIT
Begin DoDot:1
+42 SET MDX0=$GET(^TMP("PXKENC",$JOB,MDVST,"POV",MDICD,0))
SET MDX802=$GET(^(802))
+43 SET CODE=+$GET(MDX0,U)
SET GDIAG=$$ICDDATA^ICDXCODE(80,CODE,MDENCDT)
+44 if CODE
SET DIAG=$PIECE(GDIAG,U,2)_U_$PIECE(GDIAG,U,4)
+45 SET CAT=$PIECE(MDX802,U)
+46 if CAT
SET CAT=$PIECE($GET(^AUTNPOV(CAT,0)),U)
+47 SET MDCTR=MDCTR+1
SET @RESULTS@(MDCTR)="POV"_U_+$GET(MDX0,U)_U_$PIECE(DIAG,U)_U_CAT_U_$PIECE(DIAG,U,2)_U_($PIECE(MDX0,U,12)="P")
SET MDCK=MDCK+1
End DoDot:1
+48 ;^TMP("MDENC",$J,n)="CPT"^CPT IEN^CPT CODE^provider narrative category^provider narrative (Description)^^Quantity
+49 IF +MDVST>0
SET MDCPT=0
FOR
SET MDCPT=$ORDER(^TMP("PXKENC",$JOB,MDVST,"CPT",MDCPT))
if 'MDCPT
QUIT
Begin DoDot:1
+50 SET MDX0=$GET(^TMP("PXKENC",$JOB,MDVST,"CPT",MDCPT,0))
SET MDX802=$GET(^(802))
+51 SET CODE=+$GET(MDX0,U)
+52 if CODE
SET CODE=$$CPT^ICPTCOD(CODE,MDVST)
+53 if CODE
SET DIAG=$PIECE(CODE,U,2,3)
+54 SET CAT=$PIECE(MDX802,U)
+55 if CAT
SET CAT=$PIECE($GET(^AUTNPOV(CAT,0)),U)
+56 SET QTY=$PIECE(MDX0,U,16)
+57 SET MDDESC=""
DO CPTLEX^MDRPCWU(.RESLT,$PIECE(DIAG,U),"CPT")
+58 SET MDCLL=""
FOR
SET MDCLL=$ORDER(^TMP("MDLEX",$JOB,MDCLL))
if MDCLL<1
QUIT
SET MDDESC=$PIECE(^(MDCLL),"^",3)
+59 if $LENGTH(MDDESC)>230
SET MDDESC=$EXTRACT(MDDESC,1,230)
KILL ^TMP("MDLEX",$JOB),RESLT
+60 if MDDESC=""
SET MDDESC=$PIECE(DIAG,U,2)
+61 SET MDCTR=MDCTR+1
SET @RESULTS@(MDCTR)="CPT"_U_+$GET(MDX0,U)_U_$PIECE(DIAG,U)_U_CAT_U_MDDESC_U_U_QTY
SET MDCK=MDCK+1
End DoDot:1
+62 KILL ^TMP("PXKENC",$JOB)
+63 IF 'MDVST!(+MDCK<1)
Begin DoDot:1
+64 SET MDDDN=$ORDER(^MDD(702,"ACON",MDCCON,+STUDY),-1)
SET MDVST=0
+65 IF MDDDN
Begin DoDot:2
+66 SET MDDDV=$PIECE($GET(^MDD(702,+MDDDN,0)),U,7)
+67 if $LENGTH(MDDDV,";")>1
SET MDENCDT=$PIECE(MDDDV,";",2)
SET MDVST=+$GET(^MDD(702,+MDDDN,1))
SET MDVST=$SELECT(+MDVST<1:0,1:+MDVST)
+68 IF +MDVST>0
SET MDNCTR=MDCTR
FOR LLB=2:1:MDCTR
KILL @RESULTS@(MDCTR)
SET MDNCTR=MDNCTR-1
End DoDot:2
End DoDot:1
+69 IF $GET(MDFLST(1))'=""
SET MDLL=0
FOR
SET MDLL=$ORDER(MDFLST(MDLL))
if MDLL<1
QUIT
if $GET(MDFLST(MDLL))'=""
SET MDCTR=MDCTR+1
SET @RESULTS@(MDCTR)=$GET(MDFLST(MDLL))
+70 if MDCK>0
QUIT
+71 if 'MDVST
QUIT
+72 DO ENCEVENT^PXAPI(MDVST)
if $GET(MDNCTR)>0
SET MDCTR=MDNCTR
+73 ;^TMP("MDENC",$J,n)="PRV"^CODE^^NARR^^Primary (1=Yes,0=No)
+74 SET MDPROV=0
FOR
SET MDPROV=$ORDER(^TMP("PXKENC",$JOB,MDVST,"PRV",MDPROV))
if 'MDPROV
QUIT
Begin DoDot:1
+75 QUIT
+76 SET MDX0=$GET(^TMP("PXKENC",$JOB,MDVST,"PRV",MDPROV,0))
+77 SET CODE=+$PIECE(MDX0,U)
+78 IF +CODE
SET MDCTR=MDCTR+1
SET @RESULTS@(MDCTR)="PRV"_U_CODE_U_U_$$GET1^DIQ(200,+CODE_",",.01,"E")_U_U_($PIECE(MDX0,U,4)="P")
End DoDot:1
+79 ;^TMP("MDENC",$J,n)="POV"^ICD9 IEN^ICD9 CODE^provider narrative category^provider narrative (Short Description)^Primary (1=Yes,0=No)
+80 SET MDICD=0
FOR
SET MDICD=$ORDER(^TMP("PXKENC",$JOB,MDVST,"POV",MDICD))
if 'MDICD
QUIT
Begin DoDot:1
+81 SET MDX0=$GET(^TMP("PXKENC",$JOB,MDVST,"POV",MDICD,0))
SET MDX802=$GET(^(802))
+82 SET CODE=+$GET(MDX0,U)
SET GDIAG=$$ICDDATA^ICDXCODE(80,CODE,MDENCDT)
+83 if CODE
SET DIAG=$PIECE(GDIAG,U,2)_U_$PIECE(GDIAG,U,4)
+84 SET CAT=$PIECE(MDX802,U)
+85 if CAT
SET CAT=$PIECE($GET(^AUTNPOV(CAT,0)),U)
+86 SET MDCTR=MDCTR+1
SET @RESULTS@(MDCTR)="POV"_U_+$GET(MDX0,U)_U_$PIECE(DIAG,U)_U_CAT_U_$PIECE(DIAG,U,2)_U_($PIECE(MDX0,U,12)="P")
End DoDot:1
+87 ;^TMP("MDENC",$J,n)="CPT"^CPT IEN^CPT CODE^provider narrative category^provider narrative (Short Description)^^Quantity
+88 SET MDCPT=0
FOR
SET MDCPT=$ORDER(^TMP("PXKENC",$JOB,MDVST,"CPT",MDCPT))
if 'MDCPT
QUIT
Begin DoDot:1
+89 SET MDX0=$GET(^TMP("PXKENC",$JOB,MDVST,"CPT",MDCPT,0))
SET MDX802=$GET(^(802))
+90 SET CODE=+$GET(MDX0,U)
+91 if CODE
SET CODE=$$CPT^ICPTCOD(CODE,MDVST)
+92 if CODE
SET DIAG=$PIECE(CODE,U,2,3)
+93 SET CAT=$PIECE(MDX802,U)
+94 if CAT
SET CAT=$PIECE($GET(^AUTNPOV(CAT,0)),U)
+95 SET QTY=$PIECE(MDX0,U,16)
+96 SET MDDESC=""
DO CPTLEX^MDRPCWU(.RESLT,$PIECE(DIAG,U),"CPT")
+97 SET MDCLL=""
FOR
SET MDCLL=$ORDER(^TMP("MDLEX",$JOB,MDCLL))
if MDCLL<1
QUIT
SET MDDESC=$PIECE(^(MDCLL),"^",3)
+98 if $LENGTH(MDDESC)>230
SET MDDESC=$EXTRACT(MDDESC,1,230)
KILL ^TMP("MDLEX",$JOB),RESLT
+99 if MDDESC=""
SET MDDESC=$PIECE(DIAG,U,2)
+100 SET MDCTR=MDCTR+1
SET @RESULTS@(MDCTR)="CPT"_U_+$GET(MDX0,U)_U_$PIECE(DIAG,U)_U_CAT_U_MDDESC_U_U_QTY
End DoDot:1
+101 KILL ^TMP("PXKENC",$JOB)
+102 QUIT
SETGLO(MDGLO1,MDGLO2) ; Set the ICD and CPT from device into a global array
+1 NEW MDA,MDB,MDC
+2 IF +$GET(@MDGLO1@(1))<1&(+$GET(@MDGLO1@(2))<1)
QUIT
+3 SET MDA=$ORDER(@MDGLO2@("POV",""),-1)
+4 SET MDB=$ORDER(@MDGLO2@("CPT",""),-1)
+5 FOR MDC=1:1:+$GET(@MDGLO1@(1))
SET MDA=MDA+1
SET @MDGLO2@("POV",MDA)=$GET(@MDGLO1@(1,MDC))
+6 FOR MDC=1:1:+$GET(@MDGLO1@(2))
SET MDB=MDB+1
SET @MDGLO2@("CPT",MDB)=$GET(@MDGLO1@(2,MDC))
+7 SET @MDGLO2@("POV",0)=MDA
SET @MDGLO2@("CPT",0)=MDB
+8 QUIT
NTIU(P1,RECID) ; Create New TIU note for Result
+1 IF $GET(^MDD(702,+P1,0))=""
QUIT 0
+2 NEW MDNEWN,MDFG,MDHVL,MDKK
SET MDFG=0
+3 DO GETLST^XPAR(.MDHVL,"SYS","MD GET HIGH VOLUME")
+4 FOR MDKK=0:0
SET MDKK=$ORDER(MDHVL(MDKK))
if MDKK<1
QUIT
IF $PIECE($GET(MDHVL(MDKK)),"^")=+$PIECE(^MDD(702,+P1,0),U,4)
SET MDFG=1
QUIT
+5 IF $PIECE($GET(^MDS(702.01,+$PIECE(^MDD(702,+P1,0),U,4),0)),U,6)=2
SET MDNEWN=$$NEWTIUN^MDRPCOT2(+P1)
+6 IF +$PIECE($GET(^MDS(702.01,+$PIECE(^MDD(702,+P1,0),U,4),0)),U,10)!(+MDFG)
SET MDNEWN=$$NEWTIUN^MDRPCOTH(+P1,RECID)
+7 QUIT 1
