source: FOIAVistA/trunk/r/CLINICAL_PROCEDURES-MD/MDRPCW.m

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

initial load of FOIAVistA 6/30/08 version
File size: 8.4 KB
Line 
1MDRPCW ; HOIFO/NCA - Calls to AICS;04/01/2003 ;11/22/06 08:30
2 ;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
3 ; Reference Integration Agreement:
4 ; IA #142 [Subscription] Access ^DIC(31 NAME field (#.01) with FM
5 ; IA #174 [Subscription] Access DPT(DFN,.372) node.
6 ; IA #649 [Subscription] Access DG(391 with FM for
7 ; IGNORE VETERAN CHECK field (#.02).
8 ; IA #1296 [Subscription] IBDF18A call
9 ; IA #1593 [Subscription] Access to Provider Narrative file
10 ; (#9999999.27)
11 ; IA #1894 [Subscription] PXAPI call
12 ; IA #1995 [Supported] ICPTCOD calls
13 ; IA #10082 [Supported] Global Access to ICD Diagnosis file (#80)
14 ; IA #10060 [Supported] Access File 200
15 ; IA #10061 [Supported] VADPT calls
16 ;
17 Q
18RPC(RESULTS,OPTION,DFN,MDSTUD) ; [Procedure] Main RPC call
19 ; RPC: [MD TMDCIDC]
20 ;
21 ; DFN=Patient internal entry number in Patient file (#2)
22 ; MDSTUD=CP study internal entry number
23 ;
24 D CLEAN^DILF
25 S RESULTS=$NA(^TMP("MDRPCW",$J)) K @RESULTS
26 I $G(MDSTUD)="" S @RESULTS@(0)="-1^No Study." Q
27 I $T(@OPTION)="" D Q
28 .S @RESULTS@(0)="-1^Error in RPC: MD TMDCIDC at "_OPTION_U_$T(+0)
29 D @OPTION S:'$D(@RESULTS) @RESULTS@(0)="-1^No return"
30 D CLEAN^DILF
31 Q
32PROC ; get list of procedures for clinic
33 N CLIN,MDARR,MDPR,MDV
34 S MDV=$$GET1^DIQ(702,+MDSTUD_",",.07,"I")
35 I $G(MDV)="" S @RESULTS@(0)="-1^No Visit." Q
36 S MDPR=$$GET1^DIQ(702,+MDSTUD_",",.04,"I")
37 I '$G(MDPR) S @RESULTS@(0)="-1^No CP Definition." Q
38 S CLIN=$$GET1^DIQ(702.01,+MDPR_",",.05,"I")
39 I 'CLIN S CLIN=+$P(MDV,";",3) I 'CLIN S @RESULTS@(0)="-1^No Hospital Location." Q
40 D GETLST^IBDF18A(CLIN,"DG SELECT CPT PROCEDURE CODES","MDARR",,,1,DT)
41 N MDIDX,MDMOD,CODES,MDFST S MDIDX=0 M @RESULTS=MDARR
42 F S MDIDX=$O(@RESULTS@(MDIDX)) Q:'+MDIDX D
43 . I @RESULTS@(MDIDX)="" K @RESULTS@(MDIDX) Q
44 . S MDMOD=0,CODES="",MDFST=1
45 . F S MDMOD=$O(@RESULTS@(MDIDX,"MODIFIER",MDMOD)) Q:(MDMOD="") D
46 . . I MDFST S MDFST=0
47 . . E S CODES=CODES_";"
48 . . S CODES=CODES_@RESULTS@(MDIDX,"MODIFIER",MDMOD)
49 . K @RESULTS@(MDIDX,"MODIFIER")
50 . I 'MDFST S $P(@RESULTS@(MDIDX),U,12)=CODES
51 Q
52DIAG ; get list of diagnoses for clinic
53 N CLIN,MDARR,MDPR,MDV
54 S MDV=$$GET1^DIQ(702,+MDSTUD_",",.07,"I")
55 I $G(MDV)="" S @RESULTS@(0)="-1^No Visit." Q
56 S MDPR=$$GET1^DIQ(702,+MDSTUD_",",.04,"I")
57 I '$G(MDPR) S @RESULTS@(0)="-1^No CP Definition." Q
58 S CLIN=$$GET1^DIQ(702.01,+MDPR_",",.05,"I")
59 I 'CLIN S CLIN=+$P(MDV,";",3) I 'CLIN S @RESULTS@(0)="-1^No Hospital Location." Q
60 D GETLST^IBDF18A(CLIN,"DG SELECT ICD-9 DIAGNOSIS CODES","MDARR",,,,DT)
61 M @RESULTS=MDARR
62 Q
63SCDISP ; Return Service Connected % and Rated Disabilities
64 N VAEL,VAERR,I,MDLST,DIS,MDSC,X2
65 D ELIG^VADPT
66 S:'+VAEL(3) @RESULTS@(1)="Service Connected: NO"
67 S:+VAEL(3) @RESULTS@(1)="SC Percent: "_$P(VAEL(3),U,2)_"%"
68 I 'VAEL(4),'$$GET1^DIQ(391,+VAEL(6)_",",.02,"I") S @RESULTS@(2)="Rated Disabilities: NOT A VETERAN." D KVAR^VADPT Q
69 S @RESULTS@(2)="Rated Disabilities: "
70 S I=0,MDLST=0 F S I=$O(^DPT(DFN,.372,I)) Q:'I S X2=^(I,0) D
71 . S DIS=$$GET1^DIQ(31,+X2_",",.01,"E") Q:DIS=""
72 . S MDSC=$S($P(X2,U,3):"SC",$P(X2,U,3)']"":"not specified",1:"NSC")
73 . S MDLST=MDLST+1,@RESULTS@(MDLST+2)=" "_DIS_" ("_$P(X2,U,2)_"%-"_MDSC_")"
74 I 'MDLST S @RESULTS@(2)=@RESULTS@(2)_"NONE STATED"
75 D KVAR^VADPT
76 Q
77PCEDISP ; Return print text to display PCE data
78 ;S RESULTS=$NA(^TMP("MDENC",$J)) K @RESULTS
79 S STUDY=+MDSTUD
80 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=";"
81 N LLB,MDDDN,MDDDV,MDCK,MDNCTR,MDPFLG S (MDCK,MDPFLG)=0
82 Q:'$G(STUDY)
83 Q:'$G(^MDD(702,+STUDY,0))
84 D NOW^%DTC S MDDEF=% K % S MDCTR=0
85 K ^TMP("MDDAR",$J),GLOARR,MDFLST
86 S MDX=$G(^MDD(702,+STUDY,0)),MDX1=$G(^(1)),MDCCON=$P(MDX,U,5)
87 S MDVST=$P(MDX1,U),MDDFN=$P(MDX,U) Q:'MDDFN
88 S:+MDVST MDPFLG=1
89 S MDVSTR=$P(MDX,U,7),MDDAR=$NA(^TMP("MDDAR",$J)),MDDAR2=$NA(GLOARR),@MDDAR2@("POV",0)=0,@MDDAR2@("CPT",0)=0,MDLC=0
90 I 'MDVST S MDRP=0 F S MDRP=$O(^MDD(702,STUDY,.1,MDRP)) Q:'MDRP D
91 .S MDRST=$P($G(^MDD(702,STUDY,.1,+MDRP,0)),"^",3)
92 .I +MDRST D CICNV^MDHL7U3(+MDRST,.MDDAR) D SETGLO^MDRPCW1(.MDDAR,.MDDAR2)
93 .K ^TMP("MDDAR",$J) Q
94 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))
95 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))
96 I MDVST>0 S MDENCDT=$P(MDVSTR,";",2),MDLOCN=$P(MDVSTR,";",3)
97 ;E S MDENCDT=$$PDT^MDRPCOT1(STUDY)
98 E S MDENCDT=$P(MDVSTR,";",2)
99 S:$L(MDVSTR,";")=1 MDVSTR=";"_MDVSTR
100 S MDVSTR=$$GETVSTR^MDRPCOT1(MDDFN,MDVSTR,+$P(MDX,U,4),$P(MDX,U,2)),MDLOCN=$P(MDVSTR,";",1)
101 S:'MDENCDT MDENCDT=$P(MDVSTR,";",2)
102 S:'MDENCDT MDENCDT=MDDEF
103 S:'MDLOCN MDLOCN=$P(MDVSTR,";")
104 S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="Visit #: "_$S(MDVST>0:MDVST,1:"")
105 I '+MDVST S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="Encounter Date/Time: "_$E(MDENCDT,4,5)_"/"_$E(MDENCDT,6,7)_"/"_$E(MDENCDT,2,3)
106 I '+MDVST S MDVST=$$GETENC^PXAPI(MDDFN,MDENCDT,MDLOCN),MDVST=$S(+MDVST<1:0,1:+MDVST),MDCTR=MDCTR+1,@RESULTS@(MDCTR)="Visit # For Encounter Date: "_$S(MDVST>0:MDVST,1:"")
107 I +MDVST>0 D ENCEVENT^PXAPI(MDVST)
108 I +MDVST>0 S MDPROV=0 F S MDPROV=$O(^TMP("PXKENC",$J,MDVST,"PRV",MDPROV)) Q:'MDPROV D
109 .Q:'MDPFLG
110 .S MDX0=$G(^TMP("PXKENC",$J,MDVST,"PRV",MDPROV,0))
111 .S CODE=+$P(MDX0,U)
112 .I +CODE S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="Provider: "_$$GET1^DIQ(200,+CODE_",",.01,"E")_" "_$S($P(MDX0,U,4)="P":"Primary",1:"")
113 I +MDVST>0 S MDICD=0 F S MDICD=$O(^TMP("PXKENC",$J,MDVST,"POV",MDICD)) Q:'MDICD D
114 .S MDX0=$G(^TMP("PXKENC",$J,MDVST,"POV",MDICD,0)),MDX802=$G(^(802))
115 .S CODE=+$G(MDX0,U)
116 .S:CODE DIAG=$P($G(^ICD9(+CODE,0)),U)_U_$P($G(^ICD9(+CODE,0)),U,3)
117 .S CAT=$P(MDX802,U)
118 .S:CAT CAT=$P($G(^AUTNPOV(CAT,0)),U)
119 .S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="Diagnosis: "_$P(DIAG,U,2)_" "_$S($P(MDX0,U,12)="P":"Primary",1:""),MDCK=MDCK+1
120 I +MDVST>0 S MDCPT=0 F S MDCPT=$O(^TMP("PXKENC",$J,MDVST,"CPT",MDCPT)) Q:'MDCPT D
121 .S MDX0=$G(^TMP("PXKENC",$J,MDVST,"CPT",MDCPT,0)),MDX802=$G(^(802))
122 .S CODE=+$G(MDX0,U)
123 .S:CODE CODE=$$CPT^ICPTCOD(CODE,MDVST)
124 .S:CODE DIAG=$P(CODE,U,2,3)
125 .S CAT=$P(MDX802,U)
126 .S:CAT CAT=$P($G(^AUTNPOV(CAT,0)),U)
127 .S QTY=$P(MDX0,U,16)
128 .S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="CPT: "_$P(DIAG,U,2)_"-"_QTY,MDCK=MDCK+1
129 K ^TMP("PXKENC",$J)
130 I 'MDVST!(+MDCK<1) D
131 .S MDDDN=$O(^MDD(702,"ACON",MDCCON,+STUDY),-1),MDVST=0
132 .I MDDDN D
133 ..S MDDDV=$P($G(^MDD(702,+MDDDN,0)),U,7)
134 ..S:$L(MDDDV,";")>1 MDENCDT=$P(MDDDV,";",2),MDVST=+$G(^MDD(702,+MDDDN,1)),MDVST=$S(+MDVST<1:0,1:+MDVST)
135 ..I +MDVST>0 S MDNCTR=0
136 ..S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="Previous Study # Used: "_+MDDDN
137 ..S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="Previous Visit #: "_MDVST_" "_$E(MDENCDT,4,5)_"/"_$E(MDENCDT,6,7)_"/"_$E(MDENCDT,2,3)
138 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))
139 Q:MDCK>0
140 Q:'MDVST
141 D ENCEVENT^PXAPI(MDVST) S:$G(MDNCTR)>0 MDCTR=MDNCTR
142 S MDPROV=0 F S MDPROV=$O(^TMP("PXKENC",$J,MDVST,"PRV",MDPROV)) Q:'MDPROV D
143 .Q
144 .S MDX0=$G(^TMP("PXKENC",$J,MDVST,"PRV",MDPROV,0))
145 .S CODE=+$P(MDX0,U)
146 .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")
147 ;^TMP("MDENC",$J,n)="POV"^ICD9 IEN^ICD9 CODE^provider narrative category^provider narrative (Short Description)^Primary (1=Yes,0=No)
148 S MDICD=0 F S MDICD=$O(^TMP("PXKENC",$J,MDVST,"POV",MDICD)) Q:'MDICD D
149 .S MDX0=$G(^TMP("PXKENC",$J,MDVST,"POV",MDICD,0)),MDX802=$G(^(802))
150 .S CODE=+$G(MDX0,U)
151 .S:CODE DIAG=$P($G(^ICD9(+CODE,0)),U)_U_$P($G(^ICD9(+CODE,0)),U,3)
152 .S CAT=$P(MDX802,U)
153 .S:CAT CAT=$P($G(^AUTNPOV(CAT,0)),U)
154 .S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="Diagnosis: "_$P(DIAG,U,2)_" "_$S($P(MDX0,U,12)="P":"Primary",1:"")
155 S MDCPT=0 F S MDCPT=$O(^TMP("PXKENC",$J,MDVST,"CPT",MDCPT)) Q:'MDCPT D
156 .S MDX0=$G(^TMP("PXKENC",$J,MDVST,"CPT",MDCPT,0)),MDX802=$G(^(802))
157 .S CODE=+$G(MDX0,U)
158 .S:CODE CODE=$$CPT^ICPTCOD(CODE,MDVST)
159 .S:CODE DIAG=$P(CODE,U,2,3)
160 .S CAT=$P(MDX802,U)
161 .S:CAT CAT=$P($G(^AUTNPOV(CAT,0)),U)
162 .S QTY=$P(MDX0,U,16)
163 .S MDCTR=MDCTR+1,@RESULTS@(MDCTR)="CPT: "_$P(DIAG,U,2)_"-"_QTY
164 K ^TMP("PXKENC",$J)
165 Q
166TIMEMET ; Check if appointment time is met
167 N MDNOW,MDTIM,MDV
168 S MDV=$$GET1^DIQ(702,+MDSTUD_",",.07,"I")
169 I $G(MDV)="" S @RESULTS@(0)="-1^No Visit." Q
170 I $L(MDV,";")=1 S MDTIM=MDV
171 E S MDTIM=$P(MDV,";",2)
172 I 'MDTIM S @RESULTS@(0)="-1^No Visit Date/Time." Q
173 D NOW^%DTC S MDNOW=% K %
174 I MDNOW<MDTIM S @RESULTS@(0)="0^Appointment/Visit Date/Time not met." Q
175 S @RESULTS@(0)="1^Appointment/Visit Date/Time have met."
176 Q
Note: See TracBrowser for help on using the repository browser.