153 lines
8.0 KiB
Mathematica
153 lines
8.0 KiB
Mathematica
MDRPCW1 ; HOIFO/NCA - MD TMDENCOUNTER Object; [05-28-2002 12:55] ;4/4/06 08:45
|
|
;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
|
|
; 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 call
|
|
; IA #1995 [Supported] ICPTCOD calls
|
|
; IA #2288 [Supported] CPCONE^LEXU call
|
|
; IA #2348 [Subscription] SCCOND^PXUTLSCC call
|
|
; IA #2950 [Supported] LOOK^LEXA call
|
|
; IA #10082 [Supported] Global Access to ICD Diagnosis file (#80)
|
|
; IA #10060 [Supported] FILE 200 references
|
|
;
|
|
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) ; return list after lexicon lookup
|
|
N CODE,LEX,MDLST,MDI,LEXIEN,MDVAL
|
|
S RESULTS=$NA(^TMP("MDLEX",$J)) K @RESULTS
|
|
S MDDATE=DT
|
|
S:MDAPP="CPT" MDAPP="CHP" ; LEX PATCH 10
|
|
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" S CODE=$$ICDONE^LEXU(+MDVAL,MDDATE),@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 LLB,MDDDN,MDDDV,MDCK,MDNCTR,MDPFLG 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),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)
|
|
.S:CODE DIAG=$P($G(^ICD9(+CODE,0)),U)_U_$P($G(^ICD9(+CODE,0)),U,3)
|
|
.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 (Short 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 MDCTR=MDCTR+1,@RESULTS@(MDCTR)="CPT"_U_+$G(MDX0,U)_U_$P(DIAG,U)_U_CAT_U_$P(DIAG,U,2)_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)
|
|
.S:CODE DIAG=$P($G(^ICD9(+CODE,0)),U)_U_$P($G(^ICD9(+CODE,0)),U,3)
|
|
.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 MDCTR=MDCTR+1,@RESULTS@(MDCTR)="CPT"_U_+$G(MDX0,U)_U_$P(DIAG,U)_U_CAT_U_$P(DIAG,U,2)_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) ; Create New TIU note for Result
|
|
I $G(^MDD(702,+P1,0))="" Q 0
|
|
N MDNEWN
|
|
S:$P($G(^MDS(702.01,+$P(^MDD(702,+P1,0),U,4),0)),U,6)=2 MDNEWN=$$NEWTIUN^MDRPCOT2(+P1)
|
|
Q 1
|