PXBPMOD ;ISA/EW,ESW - PROMPT MOD ; 10/31/02 12:12pm
;;1.0;PCE PATIENT CARE ENCOUNTER;**73,88,89,108**Aug 12, 1996
;
;
;
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
S PXGLB="^AUPNVCPT"
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;"
L +@(PXGLB_"(DA)"):10
D ^DIE
L -@(PXGLB_"(DA)")
Q
;
CPTMOD ;Prompt for CPT Modifiers
N PXMOD,PXERR,PXI
S DR=1
S DIE=PXGLB_"("
S DIC(0)="AELMQ"
L +@(PXGLB_"(DA)")
;--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
L -@(PXGLB_"(DA)")
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,Y
S DIC=81
S DIC(0)="BN"
D ^DIC
Q Y
PXBPMOD ;ISA/EW,ESW - PROMPT MOD ; 10/31/02 12:12pm
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**73,88,89,108**Aug 12, 1996
+2 ;
+3 ;
+4 ;
+5 QUIT
+6 ;
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
+16 SET PXGLB="^AUPNVCPT"
+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 ;
+7 SET DA=+Y
+8 SET DIE=PXGLB_"("
+9 SET DR=".02////^S X=PXPAT;.03////^S X=PXVST;"
+10 LOCK +@(PXGLB_"(DA)"):10
+11 DO ^DIE
+12 LOCK -@(PXGLB_"(DA)")
+13 QUIT
+14 ;
CPTMOD ;Prompt for CPT Modifiers
+1 NEW PXMOD,PXERR,PXI
+2 SET DR=1
+3 SET DIE=PXGLB_"("
+4 SET DIC(0)="AELMQ"
+5 LOCK +@(PXGLB_"(DA)")
+6 ;--File modifiers entered before prompting user
+7 IF $GET(PXMODSTR)]""
Begin DoDot:1
+8 IF $LENGTH(PXMODSTR,",")=1
SET DR="1//"_PXMODSTR
QUIT
+9 SET PXMOD=""
+10 FOR PXI=1:1
SET PXMOD=$PIECE(PXMODSTR,",",PXI)
IF PXMOD=""
QUIT
Begin DoDot:2
+11 SET PXERR=""
+12 DO VAL^DIE(9000010.181,DA,.01,"",PXMOD,.PXERR)
+13 IF PXERR="^"
QUIT
+14 SET DR="1///^S X=PXMOD"
+15 DO ^DIE
End DoDot:2
+16 SET DR=1
End DoDot:1
+17 DO ^DIE
+18 LOCK -@(PXGLB_"(DA)")
+19 QUIT
+20 ;
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,Y
+3 SET DIC=81
+4 SET DIC(0)="BN"
+5 DO ^DIC
+6 QUIT Y
