- 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
