source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRCPT8.m@ 1766

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

initial load of WorldVistAEHR
File size: 2.8 KB
RevLine 
[613]1RMPRCPT8 ;HIN/RVD-1358 CPT MODIFIER UTILITY ;11/5/99
2 ;;3.0;PROSTHETICS;**41,69**;Feb 09, 1996
3 ;
4 ;RVD 5/14/02 patch #69 - changed GX modifier to GY.
5 ;process CPT field
6 ;Set variable RMCPT for all valid CPT modifier.
7 Q:'$D(X)
8 N DIR,RM6611,RDA,RMCPT1,RMCPSO,RMCP0,RMCP4,RMCRF,RMCBW,RMCPT5,RMHCPCS,RMCP11,RMCLEN,DTOUT,DIROUT,DUOUT
9 S RM6611=X
10 K RMCPT1,X
11 S RMCP4=$G(^RMPR(661.1,RM6611,4))
12 S RMCP11=$G(^RMPR(661.1,RM6611,0))
13 S RMCP5=$G(^RMPR(661.1,RM6611,5))
14 S RMCRF=$P(RMCP5,U,1)
15 S (RMCPT1,RMCPHC)=$P(RMCP4,U,1),RMCPT=""
16 S RMHCPCS=$P(RMCP11,U,1),RMCPHC2=$E(RMHCPCS,1,2)
17 S RMCPSO="C"
18 ;set CPT MODIFIER field in 664 to null if HCPCS has no CPT modifier.
19 I RMCPT1="" S $P(^RMPR(664,DA(1),1,DA,4),U,2)=RMCPT,X=RM6611 G KILL
20 ;next code will be used for different CPT Modifiers.
21 I (RMCPT1["LT"),(RMCPT1["RT") D LRT G:$D(DUOUT)!$D(DTOUT)!$D(DIRUT) EXIT
22 I (RMCPT1["KM"),(RMCPT1["KN") D KMN G:$D(DUOUT)!$D(DTOUT)!$D(DIRUT) EXIT
23 I RMCPT1["RR",$G(RMCRF) D RR G:$D(DUOUT)!$D(DTOUT)!$D(DIRUT) EXIT
24 I RMCPT1["RP" D RP G:$D(DUOUT)!$D(DTOUT)!$D(DIRUT) EXIT
25 I RMCPT1["PL" D PL G:$D(DUOUT)!$D(DTOUT)!$D(DIRUT) EXIT
26 I RMCPT1["NU" D NU G:$D(DUOUT)!$D(DTOUT)!$D(DIRUT) EXIT
27 I RMCPT1["UE" D UE G:$D(DUOUT)!$D(DTOUT)!$D(DIRUT) EXIT
28 I (RMCPT1["GY") D GY
29 I (RMCPT1["QH") D QH
30 I RMCPT1["KA" D KA
31EXIT ;CLEAN-UP
32 S RMCLEN=$L(RMCPT),RMCPT=$E(RMCPT,1,RMCLEN-1)
33 S $P(^RMPR(664,DA(1),1,DA,4),U,2)=RMCPT,X=RM6611
34KILL K DIR,RM6611,RDA,RMCPT1,RMCPSO,RMCP0,RMCP4,RMCRF,RMCBW,RMCPT5,RMHCPCS,RMCP11,RMCLEN,RMCPHC,RMCPHC2,RMCP5
35 Q
36LRT ;prompt for LEFT OR RIGHT CPT modifier
37 K DIR
38 S DIR(0)="SBO^LT:Left;RT:Right;B:Both Left and Right"
39 S DIR("A")="Enter a CPT MODIFIER for HCPCS "_RMHCPCS
40 D ^DIR I $D(DUOUT)!$D(DTOUT)!($D(Y)&(Y="")) W !,"This is a required field!!!" G LRT
41 I Y="B" S Y="LT,RT"
42 S RMCPT=RMCPT_Y_","
43 Q
44 ;
45KMN ;prompt for new impression/moulage or previous master model.
46 K DIR
47 S DIR(0)="SBO^KM:new impression/moulage;KN:previous master model"
48 S DIR("A")="Enter a CPT MODIFIER for HCPCS "_RMHCPCS
49 D ^DIR I $D(DUOUT)!$D(DTOUT)!($D(Y)&(Y="")) W !,"This is a required field!!!" G KMN
50 S RMCPT=RMCPT_Y_","
51 Q
52 ;
53RR ;Append "RR" cpt modifier"
54 S DIR(0)="Y"
55 S DIR("A")="Is this RENTAL "
56 S DIR("?")="Enter 'Y for YES' or 'N for NO' ",DIR("B")="Y"
57 D ^DIR K DIR I $D(DUOUT)!$D(DTOUT) W !,"This is a required field!!!" G RR
58 S:$G(Y) RMCPT=RMCPT_"RR,"
59 Q
60 ;
61RP ;append "RP" cpt modifier.
62 I $D(RMTYPE),((RMTYPE="R")!(RMTYPE="X")) S RMCPT=RMCPT_"RP,"
63 Q
64 ;
65UE ;append "UE" cpt modifier.
66 I (RMCPSO="V") S RMCPT=RMCPT_"UE,"
67 Q
68 ;
69NU ;append "NU" cpt modifier.
70 I (RMCPSO="C"),(RMCPT'["RR") S RMCPT=RMCPT_"NU,"
71 Q
72 ;
73QH ;append "QH" CPT modifier for Home Oxygen.
74 S RMCPT=RMCPT_"QH,"
75 Q
76 ;
77PL ;Append PL cpt modifier.
78 S RMCPT=RMCPT_"PL,"
79 Q
80 ;
81KA ;Append KA cpt modifier for HCPCS that contains wheelchair accessories.
82 S RMCPT=RMCPT_"KA,"
83 Q
84 ;
85GY ;Append GY CPT Modifier.
86 S RMCPT=RMCPT_"GY,"
87 Q
Note: See TracBrowser for help on using the repository browser.