PXBPMOD ;ISA/EW,ESW - PROMPT MOD ; 10/20/2017
;;1.0;PCE PATIENT CARE ENCOUNTER;**73,88,89,108,121,149,211**Aug 12, 1996;;Build 454
Q
;
MOD(PXVST,PXPAT,PXCPT,PXMODSTR,PXCPTIEN,PXVSTDAT,PXCNT,PXARR) ;
;CPT Modifier prompt
; Input:
; PXVST - Visit IEN.
; PXPAT - Patient IEN
; PXCPT - CPT code or IEN of its entry in CPT file (#81)
; PXMODSTR - User entered string of modifier codes in external
; format
; PXCPTIEN - IEN of CPT code entry in V CPT file (#9000010.18)
; PXVSTDAT - Visit date
; PXCNT - Number of active modifiers defined for CPT code
; Output:
; PXARR - Array containing modifiers.
;
;
N DTOUT,DUOUT,DIROUT,DA,DIC,DR,PXGLB,Y,ICPTVDT
S PXGLB="^AUPNVCPT",ICPTVDT=PXVSTDAT
I $$VALCPT(PXCPT)<1 Q
I +$$CPTOK^PXBUTL(PXCPT,PXVSTDAT)=0 Q
I $G(PXCPTIEN)]"" S DA=PXCPTIEN
I $G(PXCPTIEN)']"" D
.D FILECPT
.S (PXARR,PXNEWIEN)=DA
;Only prompt if there are active modifiers for the CPT code
D:PXCNT>0 CPTMOD
I $D(DTOUT)!$D(Y) D Q
.S (EDATA,DATA)="^C"
.;Remove incomplete V CPT entry
.I $G(PXNEWIEN)]"" D REMOVE^PXCEVFIL(PXNEWIEN)
D BLDARRY
Q
;
FILECPT ;Create a new entry in V CPT file and get IEN
N X,Y,DD,DO,DR
S DIC=PXGLB_"("
S DIC(0)=""
S X=PXCPT
D FILE^DICN
S DA=+Y
S DIE=PXGLB_"("
S DR=".02////^S X=PXPAT;.03////^S X=PXVST;"
D ^DIE
Q
;
CPTMOD ;Prompt for CPT Modifiers
N PXMOD,PXERR,PXI
S DR=1
S DIE=PXGLB_"("
S DIC(0)="AELMQ"
;--File modifiers entered before prompting user
I $G(PXMODSTR)]"" D
.I $L(PXMODSTR,",")=1 S DR="1//"_PXMODSTR Q
.S PXMOD=""
.F PXI=1:1 S PXMOD=$P(PXMODSTR,",",PXI) Q:PXMOD="" D
..S PXERR=""
..D VAL^DIE(9000010.181,DA,.01,"",PXMOD,.PXERR)
..Q:PXERR="^"
..S DR="1///^S X=PXMOD"
..D ^DIE
.S DR=1
D ^DIE
Q
;
BLDARRY ;Copy new modifiers into local array
N PXFIL,PXSUBFIL,PXSUB,PXARR2
S PXFIL=9000010.18,PXSUBFIL=9000010.181
D GETS^DIQ(PXFIL,DA,"1*","I","PXARR2")
S PXSUB=""
F S PXSUB=$O(PXARR2(PXSUBFIL,PXSUB)) Q:PXSUB="" D
.S PXARR(1,+PXSUB)=PXARR2(PXSUBFIL,PXSUB,.01,"I")
Q
;
VALCPT(X) ;Determine if CPT code is valid
;internal or external value of CPT is evaluated
N DIC,EVENTDT,Y
S EVENTDT=$S(+PXCPTIEN>0:$P($G(^AUPNVCPT(PXCPTIEN,12)),U,1),1:"")
I EVENTDT="" S EVENTDT=IDATE
S DIC=81
S DIC(0)="BN"
S DIC("S")="I $P($$CPT^ICPTCOD(Y,EVENTDT),U,7)"
D ^DIC
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBPMOD 2401 printed Mar 13, 2025@21:31:51 Page 2
PXBPMOD ;ISA/EW,ESW - PROMPT MOD ; 10/20/2017
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**73,88,89,108,121,149,211**Aug 12, 1996;;Build 454
+2 QUIT
+3 ;
MOD(PXVST,PXPAT,PXCPT,PXMODSTR,PXCPTIEN,PXVSTDAT,PXCNT,PXARR) ;
+1 ;CPT Modifier prompt
+2 ; Input:
+3 ; PXVST - Visit IEN.
+4 ; PXPAT - Patient IEN
+5 ; PXCPT - CPT code or IEN of its entry in CPT file (#81)
+6 ; PXMODSTR - User entered string of modifier codes in external
+7 ; format
+8 ; PXCPTIEN - IEN of CPT code entry in V CPT file (#9000010.18)
+9 ; PXVSTDAT - Visit date
+10 ; PXCNT - Number of active modifiers defined for CPT code
+11 ; Output:
+12 ; PXARR - Array containing modifiers.
+13 ;
+14 ;
+15 NEW DTOUT,DUOUT,DIROUT,DA,DIC,DR,PXGLB,Y,ICPTVDT
+16 SET PXGLB="^AUPNVCPT"
SET ICPTVDT=PXVSTDAT
+17 IF $$VALCPT(PXCPT)<1
QUIT
+18 IF +$$CPTOK^PXBUTL(PXCPT,PXVSTDAT)=0
QUIT
+19 IF $GET(PXCPTIEN)]""
SET DA=PXCPTIEN
+20 IF $GET(PXCPTIEN)']""
Begin DoDot:1
+21 DO FILECPT
+22 SET (PXARR,PXNEWIEN)=DA
End DoDot:1
+23 ;Only prompt if there are active modifiers for the CPT code
+24 if PXCNT>0
DO CPTMOD
+25 IF $DATA(DTOUT)!$DATA(Y)
Begin DoDot:1
+26 SET (EDATA,DATA)="^C"
+27 ;Remove incomplete V CPT entry
+28 IF $GET(PXNEWIEN)]""
DO REMOVE^PXCEVFIL(PXNEWIEN)
End DoDot:1
QUIT
+29 DO BLDARRY
+30 QUIT
+31 ;
FILECPT ;Create a new entry in V CPT file and get IEN
+1 NEW X,Y,DD,DO,DR
+2 SET DIC=PXGLB_"("
+3 SET DIC(0)=""
+4 SET X=PXCPT
+5 DO FILE^DICN
+6 SET DA=+Y
+7 SET DIE=PXGLB_"("
+8 SET DR=".02////^S X=PXPAT;.03////^S X=PXVST;"
+9 DO ^DIE
+10 QUIT
+11 ;
CPTMOD ;Prompt for CPT Modifiers
+1 NEW PXMOD,PXERR,PXI
+2 SET DR=1
+3 SET DIE=PXGLB_"("
+4 SET DIC(0)="AELMQ"
+5 ;--File modifiers entered before prompting user
+6 IF $GET(PXMODSTR)]""
Begin DoDot:1
+7 IF $LENGTH(PXMODSTR,",")=1
SET DR="1//"_PXMODSTR
QUIT
+8 SET PXMOD=""
+9 FOR PXI=1:1
SET PXMOD=$PIECE(PXMODSTR,",",PXI)
if PXMOD=""
QUIT
Begin DoDot:2
+10 SET PXERR=""
+11 DO VAL^DIE(9000010.181,DA,.01,"",PXMOD,.PXERR)
+12 if PXERR="^"
QUIT
+13 SET DR="1///^S X=PXMOD"
+14 DO ^DIE
End DoDot:2
+15 SET DR=1
End DoDot:1
+16 DO ^DIE
+17 QUIT
+18 ;
BLDARRY ;Copy new modifiers into local array
+1 NEW PXFIL,PXSUBFIL,PXSUB,PXARR2
+2 SET PXFIL=9000010.18
SET PXSUBFIL=9000010.181
+3 DO GETS^DIQ(PXFIL,DA,"1*","I","PXARR2")
+4 SET PXSUB=""
+5 FOR
SET PXSUB=$ORDER(PXARR2(PXSUBFIL,PXSUB))
if PXSUB=""
QUIT
Begin DoDot:1
+6 SET PXARR(1,+PXSUB)=PXARR2(PXSUBFIL,PXSUB,.01,"I")
End DoDot:1
+7 QUIT
+8 ;
VALCPT(X) ;Determine if CPT code is valid
+1 ;internal or external value of CPT is evaluated
+2 NEW DIC,EVENTDT,Y
+3 SET EVENTDT=$SELECT(+PXCPTIEN>0:$PIECE($GET(^AUPNVCPT(PXCPTIEN,12)),U,1),1:"")
+4 IF EVENTDT=""
SET EVENTDT=IDATE
+5 SET DIC=81
+6 SET DIC(0)="BN"
+7 SET DIC("S")="I $P($$CPT^ICPTCOD(Y,EVENTDT),U,7)"
+8 DO ^DIC
+9 QUIT Y
