RMPRCPTU ;HIN/RVD-EXTRINSIC FUNCTION FOR CPT MOD ;5/16/00
;;3.0;PROSTHETICS;**41,69**;Feb 09, 1996
;
;RVD 5/15/02 PATCH #69 - changed GX modifier to GY.
;process CPT field
;Set variable RMCPT for all valid CPT modifier.
;X=PSAS HCPCS^TYPE OF TRANSACTION^SOURCE^FILE
;rmcphc=PSAS HCPCS
;rmcpty=TYPE OF TRANSACTION
;rmcpso=SOURCE
;rmcpfi=file used (660,664 or 664.1)
;rmcpt=CPT Modifier dilimited by comma; RETURN VARIABLE
CPT(RDA) ;entry point for CPT.
N Y,DIR,DIE,DA,RM6611,RMCPT1,RMCPSO,RMCP0,RMCP4,RMCRF,RMCBW,RMCPT5,RMHCPCS,RMCP11,RMCLEN,RMCPFI,RMCPTY,RMCPHC,RMCP5,RMCPHC2
S RMCPHC=$P(RDA,U,1),RMCPTY=$P(RDA,U,2),RMCPSO=$P(RDA,U,3),RMCPFI=$P(RDA,U,4)
S RMCPT=""
I (RMCPHC="")!(RMCPTY="") Q
K RMCPT1,DIR
S RM6611=RMCPHC,RMCP4=$G(^RMPR(661.1,RM6611,4))
S RMCP11=$G(^RMPR(661.1,RM6611,0))
S RMCP5=$G(^RMPR(661.1,RM6611,5))
S RMCRF=$P(RMCP5,U,1)
S (RMCPT1,RMCPHC)=$P(RMCP4,U,1),RMCPT=""
S RMHCPCS=$P(RMCP11,U,1),RMCPHC2=$E(RMHCPCS,1,2)
Q:RMCPT1=""
;next code will be used for different CPT Modifiers.
I (RMCPT1["LT"),(RMCPT1["RT") D LRT G:$D(DUOUT)!$D(DTOUT)!$D(DIRUT) EXIT
I (RMCPT1["KM"),(RMCPT1["KN") D KMN G:$D(DUOUT)!$D(DTOUT)!$D(DIRUT) EXIT
I RMCPT1["RR",$G(RMCRF) D RR G:$D(DUOUT)!$D(DTOUT)!$D(DIRUT) EXIT
I RMCPT1["RP" D RP G:$D(DUOUT)!$D(DTOUT)!$D(DIRUT) EXIT
I RMCPT1["UE",RMCPSO="V" D UE G:$D(DUOUT)!$D(DTOUT)!$D(DIRUT) EXIT
I RMCPT1["NU",RMCPSO="C" D NU G:$D(DUOUT)!$D(DTOUT)!$D(DIRUT) EXIT
I RMCPT1["PL" D PL G:$D(DUOUT)!$D(DTOUT)!$D(DIRUT) EXIT
I RMCPT1["GY" D GY
I RMCPT1["QH" D QH
I RMCPT1["KA" D KA
EXIT ;remove comma @ the end and return to calling program
S RMCLEN=$L(RMCPT),RMCPT=$E(RMCPT,1,RMCLEN-1)
Q
;
LRT ;prompt for LEFT OR RIGHT CPT modifier
K DIR
S DIR(0)="SBO^LT:Left;RT:Right;B:Both Left and Right"
S DIR("A")="Enter a CPT MODIFIER for HCPCS "_RMHCPCS
D ^DIR I $D(DUOUT)!$D(DTOUT)!($D(Y)&(Y="")) W !,"This is a required field!!!" G LRT
I Y="B" S Y="LT,RT"
S RMCPT=RMCPT_Y_","
Q
;
KMN ;prompt for new impression/moulage or previous master model.
K DIR
S DIR(0)="SBO^KM:new impression/moulage;KN:previous master model"
S DIR("A")="Enter a CPT MODIFIER for HCPCS "_RMHCPCS
D ^DIR I $D(DUOUT)!$D(DTOUT)!($D(Y)&(Y="")) W !,"This is a required field!!!" G KMN
S RMCPT=RMCPT_Y_","
Q
;
RR ;Append "RR" cpt modifier"
S DIR(0)="Y"
S DIR("A")="Is this RENTAL "
S DIR("?")="Enter 'Y for YES' or 'N for NO' ",DIR("B")="Y"
D ^DIR K DIR I $D(DUOUT)!$D(DTOUT) W !,"This is a required field!!!" G RR
S:$G(Y) RMCPT=RMCPT_"RR,"
Q
;
RP ;append "RP" cpt modifier.
I (RMCPTY="R")!(RMCPTY="X") S RMCPT=RMCPT_"RP,"
Q
;
UE ;append "UE" cpt modifier.
S:RMCPSO="V" RMCPT=RMCPT_"UE,"
Q
;
NU ;append "NU" cpt modifier.
I (RMCPSO="C"),(RMCPT'["RR") S RMCPT=RMCPT_"NU,"
Q
;
QH ;append "QH" CPT modifier for Home Oxygen.
S RMCPT=RMCPT_"QH,"
Q
;
PL ;Append PL cpt modifier.
S RMCPT=RMCPT_"PL,"
Q
;
KA ;Append KA cpt modifier for HCPCS that contains wheelchair accessories.
S RMCPT=RMCPT_"KA,"
Q
;
GY ;Append GY CPT Modifier.
S RMCPT=RMCPT_"GY,"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRCPTU 3114 printed Oct 16, 2024@18:34:45 Page 2
RMPRCPTU ;HIN/RVD-EXTRINSIC FUNCTION FOR CPT MOD ;5/16/00
+1 ;;3.0;PROSTHETICS;**41,69**;Feb 09, 1996
+2 ;
+3 ;RVD 5/15/02 PATCH #69 - changed GX modifier to GY.
+4 ;process CPT field
+5 ;Set variable RMCPT for all valid CPT modifier.
+6 ;X=PSAS HCPCS^TYPE OF TRANSACTION^SOURCE^FILE
+7 ;rmcphc=PSAS HCPCS
+8 ;rmcpty=TYPE OF TRANSACTION
+9 ;rmcpso=SOURCE
+10 ;rmcpfi=file used (660,664 or 664.1)
+11 ;rmcpt=CPT Modifier dilimited by comma; RETURN VARIABLE
CPT(RDA) ;entry point for CPT.
+1 NEW Y,DIR,DIE,DA,RM6611,RMCPT1,RMCPSO,RMCP0,RMCP4,RMCRF,RMCBW,RMCPT5,RMHCPCS,RMCP11,RMCLEN,RMCPFI,RMCPTY,RMCPHC,RMCP5,RMCPHC2
+2 SET RMCPHC=$PIECE(RDA,U,1)
SET RMCPTY=$PIECE(RDA,U,2)
SET RMCPSO=$PIECE(RDA,U,3)
SET RMCPFI=$PIECE(RDA,U,4)
+3 SET RMCPT=""
+4 IF (RMCPHC="")!(RMCPTY="")
QUIT
+5 KILL RMCPT1,DIR
+6 SET RM6611=RMCPHC
SET RMCP4=$GET(^RMPR(661.1,RM6611,4))
+7 SET RMCP11=$GET(^RMPR(661.1,RM6611,0))
+8 SET RMCP5=$GET(^RMPR(661.1,RM6611,5))
+9 SET RMCRF=$PIECE(RMCP5,U,1)
+10 SET (RMCPT1,RMCPHC)=$PIECE(RMCP4,U,1)
SET RMCPT=""
+11 SET RMHCPCS=$PIECE(RMCP11,U,1)
SET RMCPHC2=$EXTRACT(RMHCPCS,1,2)
+12 if RMCPT1=""
QUIT
+13 ;next code will be used for different CPT Modifiers.
+14 IF (RMCPT1["LT")
IF (RMCPT1["RT")
DO LRT
if $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIRUT)
GOTO EXIT
+15 IF (RMCPT1["KM")
IF (RMCPT1["KN")
DO KMN
if $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIRUT)
GOTO EXIT
+16 IF RMCPT1["RR"
IF $GET(RMCRF)
DO RR
if $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIRUT)
GOTO EXIT
+17 IF RMCPT1["RP"
DO RP
if $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIRUT)
GOTO EXIT
+18 IF RMCPT1["UE"
IF RMCPSO="V"
DO UE
if $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIRUT)
GOTO EXIT
+19 IF RMCPT1["NU"
IF RMCPSO="C"
DO NU
if $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIRUT)
GOTO EXIT
+20 IF RMCPT1["PL"
DO PL
if $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIRUT)
GOTO EXIT
+21 IF RMCPT1["GY"
DO GY
+22 IF RMCPT1["QH"
DO QH
+23 IF RMCPT1["KA"
DO KA
EXIT ;remove comma @ the end and return to calling program
+1 SET RMCLEN=$LENGTH(RMCPT)
SET RMCPT=$EXTRACT(RMCPT,1,RMCLEN-1)
+2 QUIT
+3 ;
LRT ;prompt for LEFT OR RIGHT CPT modifier
+1 KILL DIR
+2 SET DIR(0)="SBO^LT:Left;RT:Right;B:Both Left and Right"
+3 SET DIR("A")="Enter a CPT MODIFIER for HCPCS "_RMHCPCS
+4 DO ^DIR
IF $DATA(DUOUT)!$DATA(DTOUT)!($DATA(Y)&(Y=""))
WRITE !,"This is a required field!!!"
GOTO LRT
+5 IF Y="B"
SET Y="LT,RT"
+6 SET RMCPT=RMCPT_Y_","
+7 QUIT
+8 ;
KMN ;prompt for new impression/moulage or previous master model.
+1 KILL DIR
+2 SET DIR(0)="SBO^KM:new impression/moulage;KN:previous master model"
+3 SET DIR("A")="Enter a CPT MODIFIER for HCPCS "_RMHCPCS
+4 DO ^DIR
IF $DATA(DUOUT)!$DATA(DTOUT)!($DATA(Y)&(Y=""))
WRITE !,"This is a required field!!!"
GOTO KMN
+5 SET RMCPT=RMCPT_Y_","
+6 QUIT
+7 ;
RR ;Append "RR" cpt modifier"
+1 SET DIR(0)="Y"
+2 SET DIR("A")="Is this RENTAL "
+3 SET DIR("?")="Enter 'Y for YES' or 'N for NO' "
SET DIR("B")="Y"
+4 DO ^DIR
KILL DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
WRITE !,"This is a required field!!!"
GOTO RR
+5 if $GET(Y)
SET RMCPT=RMCPT_"RR,"
+6 QUIT
+7 ;
RP ;append "RP" cpt modifier.
+1 IF (RMCPTY="R")!(RMCPTY="X")
SET RMCPT=RMCPT_"RP,"
+2 QUIT
+3 ;
UE ;append "UE" cpt modifier.
+1 if RMCPSO="V"
SET RMCPT=RMCPT_"UE,"
+2 QUIT
+3 ;
NU ;append "NU" cpt modifier.
+1 IF (RMCPSO="C")
IF (RMCPT'["RR")
SET RMCPT=RMCPT_"NU,"
+2 QUIT
+3 ;
QH ;append "QH" CPT modifier for Home Oxygen.
+1 SET RMCPT=RMCPT_"QH,"
+2 QUIT
+3 ;
PL ;Append PL cpt modifier.
+1 SET RMCPT=RMCPT_"PL,"
+2 QUIT
+3 ;
KA ;Append KA cpt modifier for HCPCS that contains wheelchair accessories.
+1 SET RMCPT=RMCPT_"KA,"
+2 QUIT
+3 ;
GY ;Append GY CPT Modifier.
+1 SET RMCPT=RMCPT_"GY,"
+2 QUIT
