source: FOIAVistA/trunk/r/CLINICAL_PROCEDURES-MD/MDRPCW1.m@ 1783

Last change on this file since 1783 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 8.0 KB
Line 
1MDRPCW1 ; HOIFO/NCA - MD TMDENCOUNTER Object; [05-28-2002 12:55] ;4/4/06 08:45
2 ;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
3 ; Reference Integration Agreement:
4 ; IA #1573 [Supported] ICDONE^LEXU call
5 ; IA #1593 [Subscription] Access to Provider Narrative file
6 ; (#9999999.27)
7 ; IA #1609 [Supported] CONFIG^LEXSET call
8 ; IA #1894 [Subscription] PXAPI call
9 ; IA #1995 [Supported] ICPTCOD calls
10 ; IA #2288 [Supported] CPCONE^LEXU call
11 ; IA #2348 [Subscription] SCCOND^PXUTLSCC call
12 ; IA #2950 [Supported] LOOK^LEXA call
13 ; IA #10082 [Supported] Global Access to ICD Diagnosis file (#80)
14 ; IA #10060 [Supported] FILE 200 references
15 ;
16CPTMODS(RESULTS,MDCPT) ;Return CPT Modifiers for a CPT Code
17 N MDARR,MDIDX,MDI,MDNAME
18 S RESULTS=$NA(^TMP("MDMODS",$J)) K @RESULTS
19 S MDDATE=DT
20 I +($$CODM^ICPTCOD(MDCPT,$NA(MDARR),0,MDDATE)),+$D(MDARR) D
21 . S MDIDX="",MDI=0
22 . F S MDIDX=$O(MDARR(MDIDX)) Q:(MDIDX="") D
23 . . S MDI=MDI+1,MDNAME=$P(MDARR(MDIDX),U,1)
24 . . S @RESULTS@(MDNAME_MDI)=$P(MDARR(MDIDX),U,2)_U_MDNAME_U_MDIDX
25 Q
26LEX(RESULTS,MDSRCH,MDAPP) ; return list after lexicon lookup
27 N CODE,LEX,MDLST,MDI,LEXIEN,MDVAL
28 S RESULTS=$NA(^TMP("MDLEX",$J)) K @RESULTS
29 S MDDATE=DT
30 S:MDAPP="CPT" MDAPP="CHP" ; LEX PATCH 10
31 D CONFIG^LEXSET(MDAPP,MDAPP,MDDATE)
32 D LOOK^LEXA(MDSRCH,MDAPP,1,"",MDDATE)
33 I '$D(LEX("LIST",1)) S @RESULTS@(1)="-1^No matches found." Q
34 S @RESULTS@(1)=LEX("LIST",1),MDLST=1
35 S MDI="" F S MDI=$O(^TMP("LEXFND",$J,MDI)) Q:MDI'<0 D
36 . S LEXIEN=$O(^TMP("LEXFND",$J,MDI,0))
37 . S MDLST=MDLST+1,@RESULTS@(MDLST)=LEXIEN_U_^TMP("LEXFND",$J,MDI,LEXIEN)
38 K ^TMP("LEXFND",$J),^TMP("LEXHIT",$J)
39 S MDI="" F S MDI=$O(@RESULTS@(MDI)) Q:'MDI S MDVAL=$G(@RESULTS@(MDI)) D
40 . I MDAPP="ICD" S CODE=$$ICDONE^LEXU(+MDVAL,MDDATE),@RESULTS@(MDI)=CODE_U_MDVAL
41 . I MDAPP="CPT"!(MDAPP="CHP") S CODE=$$CPTONE^LEXU(+MDVAL,MDDATE),@RESULTS@(MDI)=CODE_U_MDVAL
42 . I CODE="",(MDAPP="CHP") S CODE=$$CPCONE^LEXU(+MDVAL,MDDATE),@RESULTS@(MDI)=CODE_U_MDVAL
43 Q
44GETENC(RESULTS,STUDY) ; Return the current encounter data entered
45 S RESULTS=$NA(^TMP("MDENC",$J)) K @RESULTS
46 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=";"
47 N LLB,MDDDN,MDDDV,MDCK,MDNCTR,MDPFLG S (MDCK,MDPFLG)=0
48 Q:'$G(STUDY)
49 Q:'$G(^MDD(702,+STUDY,0))
50 D NOW^%DTC S MDDEF=% K % S MDCTR=0
51 K ^TMP("MDDAR",$J),GLOARR,MDFLST
52 S MDX=$G(^MDD(702,+STUDY,0)),MDX1=$G(^(1)),MDCCON=$P(MDX,U,5)
53 S MDVST=$P(MDX1,U),MDDFN=$P(MDX,U) Q:'MDDFN
54 S:+MDVST MDPFLG=1
55 S MDVSTR=$P(MDX,U,7),MDDAR=$NA(^TMP("MDDAR",$J)),MDDAR2=$NA(GLOARR),@MDDAR2@("POV",0)=0,@MDDAR2@("CPT",0)=0,MDLC=0
56 I 'MDVST S MDRP=0 F S MDRP=$O(^MDD(702,STUDY,.1,MDRP)) Q:'MDRP D
57 .S MDRST=$P($G(^MDD(702,STUDY,.1,+MDRP,0)),"^",3)
58 .I +MDRST D CICNV^MDHL7U3(+MDRST,.MDDAR) D SETGLO(.MDDAR,.MDDAR2)
59 .K ^TMP("MDDAR",$J) Q
60 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))
61 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))
62 I MDVST>0 S MDENCDT=$P(MDVSTR,";",2),MDLOCN=$P(MDVSTR,";",3)
63 ;E S MDENCDT=$$PDT^MDRPCOT1(STUDY)
64 E S MDENCDT=$P(MDVSTR,";",2)
65 S:$L(MDVSTR,";")=1 MDVSTR=";"_MDVSTR
66 S MDVSTR=$$GETVSTR^MDRPCOT1(MDDFN,MDVSTR,+$P(MDX,U,4),$P(MDX,U,2)),MDLOCN=$P(MDVSTR,";",1)
67 S:'MDENCDT MDENCDT=$P(MDVSTR,";",2)
68 S:'MDENCDT MDENCDT=MDDEF
69 S:'MDLOCN MDLOCN=$P(MDVSTR,";")
70 D SCCOND^PXUTLSCC(MDDFN,MDENCDT,MDLOCN,MDVST,.MDARR)
71 S MDCTR=MDCTR+1
72 ; ^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
73 ;first piece 1 if the condition can be answered
74 ; 0 if the condition should be null not asked
75 ;second piece - If Scheduling has the answer, 1 = yes 0 = no
76 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"))
77 I 'MDVST S MDVST=$$GETENC^PXAPI(MDDFN,MDENCDT,MDLOCN),MDVST=$S(+MDVST<1:0,1:+MDVST)
78 I +MDVST>0 D ENCEVENT^PXAPI(MDVST)
79 ;^TMP("MDENC",$J,n)="PRV"^CODE^^NARR^^Primary (1=Yes,0=No)
80 I +MDVST>0 S MDPROV=0 F S MDPROV=$O(^TMP("PXKENC",$J,MDVST,"PRV",MDPROV)) Q:'MDPROV D
81 .S MDX0=$G(^TMP("PXKENC",$J,MDVST,"PRV",MDPROV,0))
82 .S CODE=+$P(MDX0,U)
83 .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")
84 ;^TMP("MDENC",$J,n)="POV"^ICD9 IEN^ICD9 CODE^provider narrative category^provider narrative (Short Description)^Primary (1=Yes,0=No)
85 I +MDVST>0 S MDICD=0 F S MDICD=$O(^TMP("PXKENC",$J,MDVST,"POV",MDICD)) Q:'MDICD D
86 .S MDX0=$G(^TMP("PXKENC",$J,MDVST,"POV",MDICD,0)),MDX802=$G(^(802))
87 .S CODE=+$G(MDX0,U)
88 .S:CODE DIAG=$P($G(^ICD9(+CODE,0)),U)_U_$P($G(^ICD9(+CODE,0)),U,3)
89 .S CAT=$P(MDX802,U)
90 .S:CAT CAT=$P($G(^AUTNPOV(CAT,0)),U)
91 .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
92 ;^TMP("MDENC",$J,n)="CPT"^CPT IEN^CPT CODE^provider narrative category^provider narrative (Short Description)^^Quantity
93 I +MDVST>0 S MDCPT=0 F S MDCPT=$O(^TMP("PXKENC",$J,MDVST,"CPT",MDCPT)) Q:'MDCPT D
94 .S MDX0=$G(^TMP("PXKENC",$J,MDVST,"CPT",MDCPT,0)),MDX802=$G(^(802))
95 .S CODE=+$G(MDX0,U)
96 .S:CODE CODE=$$CPT^ICPTCOD(CODE,MDVST)
97 .S:CODE DIAG=$P(CODE,U,2,3)
98 .S CAT=$P(MDX802,U)
99 .S:CAT CAT=$P($G(^AUTNPOV(CAT,0)),U)
100 .S QTY=$P(MDX0,U,16)
101 .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
102 K ^TMP("PXKENC",$J)
103 I 'MDVST!(+MDCK<1) D
104 .S MDDDN=$O(^MDD(702,"ACON",MDCCON,+STUDY),-1),MDVST=0
105 .I MDDDN D
106 ..S MDDDV=$P($G(^MDD(702,+MDDDN,0)),U,7)
107 ..S:$L(MDDDV,";")>1 MDENCDT=$P(MDDDV,";",2),MDVST=+$G(^MDD(702,+MDDDN,1)),MDVST=$S(+MDVST<1:0,1:+MDVST)
108 ..I +MDVST>0 S MDNCTR=MDCTR F LLB=2:1:MDCTR K @RESULTS@(MDCTR) S MDNCTR=MDNCTR-1
109 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))
110 Q:MDCK>0
111 Q:'MDVST
112 D ENCEVENT^PXAPI(MDVST) S:$G(MDNCTR)>0 MDCTR=MDNCTR
113 ;^TMP("MDENC",$J,n)="PRV"^CODE^^NARR^^Primary (1=Yes,0=No)
114 S MDPROV=0 F S MDPROV=$O(^TMP("PXKENC",$J,MDVST,"PRV",MDPROV)) Q:'MDPROV D
115 .Q
116 .S MDX0=$G(^TMP("PXKENC",$J,MDVST,"PRV",MDPROV,0))
117 .S CODE=+$P(MDX0,U)
118 .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")
119 ;^TMP("MDENC",$J,n)="POV"^ICD9 IEN^ICD9 CODE^provider narrative category^provider narrative (Short Description)^Primary (1=Yes,0=No)
120 S MDICD=0 F S MDICD=$O(^TMP("PXKENC",$J,MDVST,"POV",MDICD)) Q:'MDICD D
121 .S MDX0=$G(^TMP("PXKENC",$J,MDVST,"POV",MDICD,0)),MDX802=$G(^(802))
122 .S CODE=+$G(MDX0,U)
123 .S:CODE DIAG=$P($G(^ICD9(+CODE,0)),U)_U_$P($G(^ICD9(+CODE,0)),U,3)
124 .S CAT=$P(MDX802,U)
125 .S:CAT CAT=$P($G(^AUTNPOV(CAT,0)),U)
126 .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")
127 ;^TMP("MDENC",$J,n)="CPT"^CPT IEN^CPT CODE^provider narrative category^provider narrative (Short Description)^^Quantity
128 S MDCPT=0 F S MDCPT=$O(^TMP("PXKENC",$J,MDVST,"CPT",MDCPT)) Q:'MDCPT D
129 .S MDX0=$G(^TMP("PXKENC",$J,MDVST,"CPT",MDCPT,0)),MDX802=$G(^(802))
130 .S CODE=+$G(MDX0,U)
131 .S:CODE CODE=$$CPT^ICPTCOD(CODE,MDVST)
132 .S:CODE DIAG=$P(CODE,U,2,3)
133 .S CAT=$P(MDX802,U)
134 .S:CAT CAT=$P($G(^AUTNPOV(CAT,0)),U)
135 .S QTY=$P(MDX0,U,16)
136 .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
137 K ^TMP("PXKENC",$J)
138 Q
139SETGLO(MDGLO1,MDGLO2) ; Set the ICD and CPT from device into a global array
140 N MDA,MDB,MDC
141 I +$G(@MDGLO1@(1))<1&(+$G(@MDGLO1@(2))<1) Q
142 S MDA=$O(@MDGLO2@("POV",""),-1)
143 S MDB=$O(@MDGLO2@("CPT",""),-1)
144 F MDC=1:1:+$G(@MDGLO1@(1)) S MDA=MDA+1,@MDGLO2@("POV",MDA)=$G(@MDGLO1@(1,MDC))
145 F MDC=1:1:+$G(@MDGLO1@(2)) S MDB=MDB+1,@MDGLO2@("CPT",MDB)=$G(@MDGLO1@(2,MDC))
146 S @MDGLO2@("POV",0)=MDA,@MDGLO2@("CPT",0)=MDB
147 Q
148NTIU(P1) ; Create New TIU note for Result
149 I $G(^MDD(702,+P1,0))="" Q 0
150 N MDNEWN
151 S:$P($G(^MDS(702.01,+$P(^MDD(702,+P1,0),U,4),0)),U,6)=2 MDNEWN=$$NEWTIUN^MDRPCOT2(+P1)
152 Q 1
Note: See TracBrowser for help on using the repository browser.