source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRE29.m@ 1240

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1RMPRE29 ;PHX/JLT,RVD-EDIT 2319 ;10/2/03 13:04
2 ;;3.0;PROSTHETICS;**36,41,51,57,62,74,81,61**;Feb 09, 1996
3 ;
4 ;RVD patch #62 - call PCE API to update patient care encounter.
5 ; - add a screen display if no changes to the HCPCS.
6 ;RVD patch #74 - call $$STATCHK^ICPTAPIU to check if CPT Code is
7 ; active for a given date.
8 ;RVD patch #81 - roll back patch RMPR*3.0*74 and returns the screen
9 ; to the STATUS field of file #661.1.
10 ;RVD patch #61 - Bar Coding. Don't include Stock Issue for ED2.
11 ;uses DBIA # 1995 & 1997.
12 W ! S DIC="^RMPR(660,",DIC(0)="AEMQZ",DIC("A")="Select PATIENT: "
13 S DIC("W")="D EN^RMPRD1",RMEND=0
14 S DIC("S")="I ($P(^(0),U,6)!($P(^(0),U,26)'="""")),($P(^(0),U,13)'=11)" W !
15 D ^DIC G:+Y'>0 EXIT L +^RMPR(660,+Y,0):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" G EXIT
16 ;S (RMPRDA,DA)=+Y,DIE=DIC,DR="[RMPRE2319]" D ^DIE L -^RMPR(660,DA,0)
17 S DIE=DIC,(RMPRDA,DA)=+Y
18TYP1 ;edit type of transaction....
19 S R1(0)=$G(^RMPR(660,RMPRDA,0)),R1(1)=$G(^(1)),R1("AM")=$G(^("AM"))
20 S RMTOTCOS=$P(R1(0),U,16)
21 S (RMHCPC,RMHCOLD)=$P(R1(1),U,4),(RMTYPE,RMTYPS)=$P(R1(0),U,4),(RMCAT,RMCATS)=$P(R1("AM"),U,3),(RMSPE,RMSPES)=$P(R1("AM"),U,4),RMSOUR=$P(R1(1),U,14)
22TRAN K DIR S DIR(0)="660,2"
23 ;S DIR("A")="Enter Type of Transaction: "
24 S:$D(RMTYPS) DIR("B")=$S(RMTYPS="I":"INITIAL",RMTYPS="X":"REPAIR",RMTYPS="R":"REPLACE",RMTYPS="S":"SPARE",1:"")
25 D ^DIR
26 I $D(DUOUT)!$D(DTOUT) S RMEND=1 D SETED2 G QED2
27 I Y="" W !,"Please enter type of Transaction!!" G TRAN
28 S $P(R1(0),U,4)=Y,RMTYPE=Y
29 S RMTYPS=$S(Y="I":"INITIAL",Y="X":"REPAIR",Y="R":"REPLACE",Y="S":"SPARE",1:"")
30PCAT K DIR S DIR(0)="660,62"
31 S:$D(RMCATS) DIR("B")=$S(RMCATS=1:"SC/OP",RMCATS=2:"SC/IP",RMCATS=3:"NSC/IP",RMCATS=4:"NSC/OP",1:"")
32 D ^DIR
33 I $D(DUOUT)!$D(DTOUT) S RMEND=1 D SETED2 G QED2
34 I Y="" W !,"Please enter Patient Category!!" G PCAT
35 S RMCAT=Y
36 S $P(R1("AM"),U,3)=Y,RMCATS=$S(Y=1:"SC/OP",Y=2:"SC/IP",Y=3:"NSC/IP",Y=4:"NSC/OP",1:"")
37 K DIR I RMCAT<4 S $P(R1("AM"),U,4)="" G HCPC
38 S DIR(0)="660,63"
39 S:$D(RMSPES) DIR("B")=$S(RMSPES=1:"SPECIAL LEGISLATION",RMSPES=2:"A&A",RMSPES=3:"PHC",RMSPES=4:"ELIGIBILITY REFORM",1:"")
40 I RMCAT=4 D ^DIR I $D(DUOUT)!$D(DTOUT) S RMEND=1 D SETED2 G QED2
41 I RMCAT=4 S $P(R1("AM"),U,4)=Y,RMSPE=Y,RMSPES=$S(Y=1:"SPECIAL LEGISLATION",Y=2:"A&A",Y=3:"PHC",Y=4:"ELIGIBILITY REFORM",1:"")
42 K DIR
43 ;
44HCPC ;set type and ask item and HCPCS
45 D SETED2
46 ;ask source
47 N SRC
48 S SRC=$P(R1(0),U,14)
49 S DIE("NO^")="BACK"
50 S DR="12;4;4.5" D ^DIE
51 K DIE("NO^")
52 I $D(DUOUT)!$D(DTOUT)!$D(Y) S RMEND=1 G QED2
53 S R1(0)=$G(^RMPR(660,RMPRDA,0)),R1(1)=$G(^(1))
54 I $P(R1(0),U,14)'=SRC S RMHCOLD=""
55 S RMHCPC=$P(R1(1),U,4)
56 W !,"OLD CPT MODIFER: ",$P(R1(1),U,6)
57 ;if HCPCS was changed, Modifier must be changed
58 I RMHCOLD'=RMHCPC D
59 .S RDA=RMHCPC_"^"_$P(R1(0),U,4)_"^"_$P(R1(0),U,14)_"^"_660
60 .D CPT^RMPRCPTU(RDA) S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT
61 .W !,"NEW CPT MODIFIER: ",RMCPT
62 ;if HCPCS the same, ask user if want to edit modifier.
63 E D
64 .S DIR(0)="Y",DIR("B")="N",DIR("A")="Would you like to edit the CPT Modifier "
65 .D ^DIR Q:$D(DUOUT)!$D(DTOUT)
66 .I (Y>0) D
67 ..S RDA=RMHCPC_"^"_$P(R1(0),U,4)_"^"_$P(R1(0),U,14)_"^"_660
68 ..D CPT^RMPRCPTU(RDA) S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT
69 ..K DIR
70 ..W:RMCPT=$P(R1(1),U,6) !!,"***Based on the information given above, CPT modifier string has not changed!!!",!
71 ..W:RMCPT'=$P(R1(1),U,6) !,"NEW CPT MODIFIER: ",RMCPT
72 S DR="7;5;14;9;21;16;28" D ^DIE
73 I RMTOTCOS'=$P(^RMPR(660,DA,0),U,16) S DR="35////^S X=DUZ;36////^S X=DT" D ^DIE
74 I $D(DTOUT)!('$G(Y))!($D(DUOUT)) D CHK
75QED2 ;
76 Q:$D(RMPREDT)
77 ;modified by #62
78 ;call PCE API to update patient care encounter.
79 I $D(^RMPR(660,RMPRDA,10)),$P(^RMPR(660,RMPRDA,10),U,12) D
80 .S RMCHK=$$SENDPCE^RMPRPCEA(RMPRDA)
81 .I RMCHK<1 H 3
82 L -^RMPR(660,RMPRDA,0)
83 K DIR W ! S DIR(0)="Y",DIR("A")="Would You like to Edit another Entry (Y/N) " D ^DIR
84 G:'$D(DTOUT)&(Y>0) RMPRE29
85EXIT ;
86 N RMPR,RMPRSITE D KILL^XUSCLEAN
87 K DIC,DIE,DIR,%,X,Y
88 Q
89SETED2 ;set 660
90 S ^RMPR(660,DA,0)=R1(0),^RMPR(660,DA,1)=R1(1),^RMPR(660,DA,"AM")=R1("AM")
91 S DIK="^RMPR(660,",DA=RMPRDA D IX1^DIK K DIC
92 D CHK
93 Q
94 ;
95QUICK ;quick edit for HCPCS and type
96 K RMCPT
97 W ! S DIC="^RMPR(660,",DIC(0)="AEMNQZ",DIC("A")="Select NUMBER, or Patient: "
98 S DIC("W")="D EN^RMPRD1"
99 S DIC("S")="I $P(^(0),U,6)!($P(^(0),U,26)'="""")" W !
100 D ^DIC G:+Y'>0 EXIT L +^RMPR(660,+Y,0):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" G EXIT
101 ;add source
102 S (RMPRDA,DA)=+Y,DIE=DIC,DR="2;4.5"
103 S R1(0)=$G(^RMPR(660,DA,0)),R1(1)=$G(^RMPR(660,DA,1))
104 S RMTYPE=$P(R1(0),U,4),RMSOUR=$P(R1(0),U,14)
105 S RMHCOLD=$P(R1(1),U,4)
106 D ^DIE G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)!$D(Y) SET
107 S RMHCNEW=$P($G(^RMPR(660,DA,1)),U,4)
108 S RMTYPE=$P($G(^RMPR(660,DA,0)),U,4)
109 S RDA=RMHCNEW_"^"_RMTYPE_"^"_RMSOUR_"^"_660
110 W !,"OLD CPT MODIFER: ",$P(R1(1),U,6)
111 I RMHCOLD'=RMHCNEW D
112 .D CPT^RMPRCPTU(RDA)
113 .W !,"NEW CPT MODIFIER: ",RMCPT
114 .S $P(^RMPR(660,DA,1),U,6)=RMCPT
115 I RMHCOLD=RMHCNEW D
116 .W ! S DIR("B")="N",DIR(0)="Y",DIR("A")="Would You like to Edit CPT MODIFIER " D ^DIR
117 .I $D(DTOUT)!('$G(Y)) K DIR Q
118 .D CPT^RMPRCPTU(RDA)
119 .W:RMCPT=$P(R1(1),U,6) !!,"***Based on the information given above, CPT modifier string has not changed!!!",!
120 .W:RMCPT'=$P(R1(1),U,6) !,"NEW CPT MODIFIER: ",RMCPT
121 .S $P(^RMPR(660,DA,1),U,6)=RMCPT
122SET K DIR D CHK
123 ;modified by #62
124 ;call PCE API to update patient care encounter
125 I $D(^RMPR(660,RMPRDA,10)),$P(^RMPR(660,RMPRDA,10),U,12) D
126 .S RMCHK=$$SENDPCE^RMPRPCEA(RMPRDA)
127 .I RMCHK<1 H 3
128 W ! S DIR(0)="Y",DIR("A")="Would You like to Edit another Entry (Y/N)" D ^DIR
129 G:'$D(DTOUT)&(Y>0) QUICK^RMPRE29
130 L -^RMPR(660,RMPRDA,0)
131 D KILL^XUSCLEAN Q
132 ;
133CHK ;check for transaction changes
134 S RMTYPE=$P($G(^RMPR(660,RMPRDA,0)),U,4)
135 S RMHCPC=$P($G(^RMPR(660,RMPRDA,1)),U,4) Q:'$G(RMHCPC)
136 S RMCPT1=$P($G(^RMPR(661.1,RMHCPC,4)),U,1)
137 S RMCPT=$P($G(^RMPR(660,RMPRDA,1)),U,6)
138 I ((RMTYPE="R")!(RMTYPE="X")),(RMCPT'["RP"),($G(^RMPR(661.1,RMHCPC,4))["RP") D ADDRP
139 I ((RMTYPE="I")!(RMTYPE="S")),(RMCPT["RP") D DELRP
140 I (RMSOUR="C"),(RMCPT["RR") D DELNU
141 I (RMSOUR="C"),(RMCPT'["RR"),(RMCPT1["NU"),(RMCPT'["N") D ADDNU
142 K RMHCPC,RMCI,RMC,RMCLEN,RMLPIECE,RMF,RMFPIECE,RMTYPE,RMPRA,R4DA Q
143 ;return to EDIT option
144DELRP ;logic for deleting 'RP' modifier with transaction change.
145 F RMCI=1:1:8 S RMC=$P(RMCPT,",",RMCI) I RMC="RP" S $P(RMCPT,",",RMCI)="" D
146 .S RMF=$F(RMCPT,",,"),RMFPIECE=$E(RMCPT,1,RMF-2)
147 .S RMLPIECE=$E(RMCPT,RMF,32),RMCPT=RMFPIECE_RMLPIECE,RMCLEN=$L(RMCPT)
148 .I $E(RMCPT,1)="," S RMCPT=$E(RMCPT,2,RMCLEN)
149 .I $E(RMCPT,RMCLEN)="," S RMCPT=$E(RMCPT,1,RMCLEN-1)
150 .S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT
151 Q
152DELNU ;logic for deleting 'NU' modifier.
153 F RMCI=1:1:8 S RMC=$P(RMCPT,",",RMCI) I RMC="NU" S $P(RMCPT,",",RMCI)="" D
154 .S RMF=$F(RMCPT,",,"),RMFPIECE=$E(RMCPT,1,RMF-2)
155 .S RMLPIECE=$E(RMCPT,RMF,32),RMCPT=RMFPIECE_RMLPIECE,RMCLEN=$L(RMCPT)
156 .I $E(RMCPT,1)="," S RMCPT=$E(RMCPT,2,RMCLEN)
157 .I $E(RMCPT,RMCLEN)="," S RMCPT=$E(RMCPT,1,RMCLEN-1)
158 .S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT
159 Q
160 ;
161ADDRP ;logic for adding 'RP' modifier with transaction change.
162 S RMCPT=RMCPT_",RP" S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT
163 Q
164ADDNU ;logic for adding 'NU' modifier.
165 S RMCPT=RMCPT_",NU" S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT
166 Q
167 ;END
Note: See TracBrowser for help on using the repository browser.