PXBPMOD.m

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 ---PXBPMOD   2401     printed  Apr 23, 2025@18:41:25                                                                                                                                                                                                     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