[613] | 1 | PXBPMOD ;ISA/EW,ESW - PROMPT MOD ; 10/31/02 12:12pm
|
---|
| 2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**73,88,89,108,121,149**Aug 12, 1996
|
---|
| 3 | ;
|
---|
| 4 | ;
|
---|
| 5 | ;
|
---|
| 6 | Q
|
---|
| 7 | ;
|
---|
| 8 | MOD(PXVST,PXPAT,PXCPT,PXMODSTR,PXCPTIEN,PXVSTDAT,PXCNT,PXARR) ;
|
---|
| 9 | ;CPT Modifier prompt
|
---|
| 10 | ; Input:
|
---|
| 11 | ; PXVST - Visit IEN.
|
---|
| 12 | ; PXPAT - Patient IEN
|
---|
| 13 | ; PXCPT - CPT code or IEN of its entry in CPT file (#81)
|
---|
| 14 | ; PXMODSTR - User entered string of modifier codes in external
|
---|
| 15 | ; format
|
---|
| 16 | ; PXCPTIEN - IEN of CPT code entry in V CPT file (#9000010.18)
|
---|
| 17 | ; PXVSTDAT - Visit date
|
---|
| 18 | ; PXCNT - Number of active modifiers defined for CPT code
|
---|
| 19 | ; Output:
|
---|
| 20 | ; PXARR - Array containing modifiers.
|
---|
| 21 | ;
|
---|
| 22 | ;
|
---|
| 23 | N DTOUT,DUOUT,DIROUT,DA,DIC,DR,PXGLB,Y,ICPTVDT
|
---|
| 24 | S PXGLB="^AUPNVCPT",ICPTVDT=PXVSTDAT
|
---|
| 25 | I $$VALCPT(PXCPT)<1 Q
|
---|
| 26 | I +$$CPTOK^PXBUTL(PXCPT,PXVSTDAT)=0 Q
|
---|
| 27 | I $G(PXCPTIEN)]"" S DA=PXCPTIEN
|
---|
| 28 | I $G(PXCPTIEN)']"" D
|
---|
| 29 | .D FILECPT
|
---|
| 30 | .S (PXARR,PXNEWIEN)=DA
|
---|
| 31 | ;Only prompt if there are active modifiers for the CPT code
|
---|
| 32 | D:PXCNT>0 CPTMOD
|
---|
| 33 | I $D(DTOUT)!$D(Y) D Q
|
---|
| 34 | .S (EDATA,DATA)="^C"
|
---|
| 35 | .;Remove incomplete V CPT entry
|
---|
| 36 | .I $G(PXNEWIEN)]"" D REMOVE^PXCEVFIL(PXNEWIEN)
|
---|
| 37 | D BLDARRY
|
---|
| 38 | Q
|
---|
| 39 | ;
|
---|
| 40 | FILECPT ;Create a new entry in V CPT file and get IEN
|
---|
| 41 | N X,Y,DD,DO,DR
|
---|
| 42 | S DIC=PXGLB_"("
|
---|
| 43 | S DIC(0)=""
|
---|
| 44 | S X=PXCPT
|
---|
| 45 | D FILE^DICN
|
---|
| 46 | ;
|
---|
| 47 | S DA=+Y
|
---|
| 48 | S DIE=PXGLB_"("
|
---|
| 49 | S DR=".02////^S X=PXPAT;.03////^S X=PXVST;"
|
---|
| 50 | L +@(PXGLB_"(DA)"):10
|
---|
| 51 | D ^DIE
|
---|
| 52 | L -@(PXGLB_"(DA)")
|
---|
| 53 | Q
|
---|
| 54 | ;
|
---|
| 55 | CPTMOD ;Prompt for CPT Modifiers
|
---|
| 56 | N PXMOD,PXERR,PXI
|
---|
| 57 | S DR=1
|
---|
| 58 | S DIE=PXGLB_"("
|
---|
| 59 | S DIC(0)="AELMQ"
|
---|
| 60 | L +@(PXGLB_"(DA)")
|
---|
| 61 | ;--File modifiers entered before prompting user
|
---|
| 62 | I $G(PXMODSTR)]"" D
|
---|
| 63 | .I $L(PXMODSTR,",")=1 S DR="1//"_PXMODSTR Q
|
---|
| 64 | .S PXMOD=""
|
---|
| 65 | .F PXI=1:1 S PXMOD=$P(PXMODSTR,",",PXI) Q:PXMOD="" D
|
---|
| 66 | ..S PXERR=""
|
---|
| 67 | ..D VAL^DIE(9000010.181,DA,.01,"",PXMOD,.PXERR)
|
---|
| 68 | ..Q:PXERR="^"
|
---|
| 69 | ..S DR="1///^S X=PXMOD"
|
---|
| 70 | ..D ^DIE
|
---|
| 71 | .S DR=1
|
---|
| 72 | D ^DIE
|
---|
| 73 | L -@(PXGLB_"(DA)")
|
---|
| 74 | Q
|
---|
| 75 | ;
|
---|
| 76 | BLDARRY ;Copy new modifiers into local array
|
---|
| 77 | N PXFIL,PXSUBFIL,PXSUB,PXARR2
|
---|
| 78 | S PXFIL=9000010.18,PXSUBFIL=9000010.181
|
---|
| 79 | D GETS^DIQ(PXFIL,DA,"1*","I","PXARR2")
|
---|
| 80 | S PXSUB=""
|
---|
| 81 | F S PXSUB=$O(PXARR2(PXSUBFIL,PXSUB)) Q:PXSUB="" D
|
---|
| 82 | .S PXARR(1,+PXSUB)=PXARR2(PXSUBFIL,PXSUB,.01,"I")
|
---|
| 83 | Q
|
---|
| 84 | ;
|
---|
| 85 | VALCPT(X) ;Determine if CPT code is valid
|
---|
| 86 | ;internal or external value of CPT is evaluated
|
---|
| 87 | N DIC,Y
|
---|
| 88 | S DIC=81
|
---|
| 89 | S DIC(0)="BN"
|
---|
| 90 | S DIC("S")="I $P($$CPT^ICPTCOD(Y,IDATE),U,7)"
|
---|
| 91 | D ^DIC
|
---|
| 92 | Q Y
|
---|