source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRCPTU.m

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1RMPRCPTU ;HIN/RVD-EXTRINSIC FUNCTION FOR CPT MOD ;5/16/00
2 ;;3.0;PROSTHETICS;**41,69**;Feb 09, 1996
3 ;
4 ;RVD 5/15/02 PATCH #69 - changed GX modifier to GY.
5 ;process CPT field
6 ;Set variable RMCPT for all valid CPT modifier.
7 ;X=PSAS HCPCS^TYPE OF TRANSACTION^SOURCE^FILE
8 ;rmcphc=PSAS HCPCS
9 ;rmcpty=TYPE OF TRANSACTION
10 ;rmcpso=SOURCE
11 ;rmcpfi=file used (660,664 or 664.1)
12 ;rmcpt=CPT Modifier dilimited by comma; RETURN VARIABLE
13CPT(RDA) ;entry point for CPT.
14 N Y,DIR,DIE,DA,RM6611,RMCPT1,RMCPSO,RMCP0,RMCP4,RMCRF,RMCBW,RMCPT5,RMHCPCS,RMCP11,RMCLEN,RMCPFI,RMCPTY,RMCPHC,RMCP5,RMCPHC2
15 S RMCPHC=$P(RDA,U,1),RMCPTY=$P(RDA,U,2),RMCPSO=$P(RDA,U,3),RMCPFI=$P(RDA,U,4)
16 S RMCPT=""
17 I (RMCPHC="")!(RMCPTY="") Q
18 K RMCPT1,DIR
19 S RM6611=RMCPHC,RMCP4=$G(^RMPR(661.1,RM6611,4))
20 S RMCP11=$G(^RMPR(661.1,RM6611,0))
21 S RMCP5=$G(^RMPR(661.1,RM6611,5))
22 S RMCRF=$P(RMCP5,U,1)
23 S (RMCPT1,RMCPHC)=$P(RMCP4,U,1),RMCPT=""
24 S RMHCPCS=$P(RMCP11,U,1),RMCPHC2=$E(RMHCPCS,1,2)
25 Q:RMCPT1=""
26 ;next code will be used for different CPT Modifiers.
27 I (RMCPT1["LT"),(RMCPT1["RT") D LRT G:$D(DUOUT)!$D(DTOUT)!$D(DIRUT) EXIT
28 I (RMCPT1["KM"),(RMCPT1["KN") D KMN G:$D(DUOUT)!$D(DTOUT)!$D(DIRUT) EXIT
29 I RMCPT1["RR",$G(RMCRF) D RR G:$D(DUOUT)!$D(DTOUT)!$D(DIRUT) EXIT
30 I RMCPT1["RP" D RP G:$D(DUOUT)!$D(DTOUT)!$D(DIRUT) EXIT
31 I RMCPT1["UE",RMCPSO="V" D UE G:$D(DUOUT)!$D(DTOUT)!$D(DIRUT) EXIT
32 I RMCPT1["NU",RMCPSO="C" D NU G:$D(DUOUT)!$D(DTOUT)!$D(DIRUT) EXIT
33 I RMCPT1["PL" D PL G:$D(DUOUT)!$D(DTOUT)!$D(DIRUT) EXIT
34 I RMCPT1["GY" D GY
35 I RMCPT1["QH" D QH
36 I RMCPT1["KA" D KA
37EXIT ;remove comma @ the end and return to calling program
38 S RMCLEN=$L(RMCPT),RMCPT=$E(RMCPT,1,RMCLEN-1)
39 Q
40 ;
41LRT ;prompt for LEFT OR RIGHT CPT modifier
42 K DIR
43 S DIR(0)="SBO^LT:Left;RT:Right;B:Both Left and Right"
44 S DIR("A")="Enter a CPT MODIFIER for HCPCS "_RMHCPCS
45 D ^DIR I $D(DUOUT)!$D(DTOUT)!($D(Y)&(Y="")) W !,"This is a required field!!!" G LRT
46 I Y="B" S Y="LT,RT"
47 S RMCPT=RMCPT_Y_","
48 Q
49 ;
50KMN ;prompt for new impression/moulage or previous master model.
51 K DIR
52 S DIR(0)="SBO^KM:new impression/moulage;KN:previous master model"
53 S DIR("A")="Enter a CPT MODIFIER for HCPCS "_RMHCPCS
54 D ^DIR I $D(DUOUT)!$D(DTOUT)!($D(Y)&(Y="")) W !,"This is a required field!!!" G KMN
55 S RMCPT=RMCPT_Y_","
56 Q
57 ;
58RR ;Append "RR" cpt modifier"
59 S DIR(0)="Y"
60 S DIR("A")="Is this RENTAL "
61 S DIR("?")="Enter 'Y for YES' or 'N for NO' ",DIR("B")="Y"
62 D ^DIR K DIR I $D(DUOUT)!$D(DTOUT) W !,"This is a required field!!!" G RR
63 S:$G(Y) RMCPT=RMCPT_"RR,"
64 Q
65 ;
66RP ;append "RP" cpt modifier.
67 I (RMCPTY="R")!(RMCPTY="X") S RMCPT=RMCPT_"RP,"
68 Q
69 ;
70UE ;append "UE" cpt modifier.
71 S:RMCPSO="V" RMCPT=RMCPT_"UE,"
72 Q
73 ;
74NU ;append "NU" cpt modifier.
75 I (RMCPSO="C"),(RMCPT'["RR") S RMCPT=RMCPT_"NU,"
76 Q
77 ;
78QH ;append "QH" CPT modifier for Home Oxygen.
79 S RMCPT=RMCPT_"QH,"
80 Q
81 ;
82PL ;Append PL cpt modifier.
83 S RMCPT=RMCPT_"PL,"
84 Q
85 ;
86KA ;Append KA cpt modifier for HCPCS that contains wheelchair accessories.
87 S RMCPT=RMCPT_"KA,"
88 Q
89 ;
90GY ;Append GY CPT Modifier.
91 S RMCPT=RMCPT_"GY,"
92 Q
Note: See TracBrowser for help on using the repository browser.