- 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 Dec 13, 2024@02:34:06 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