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
|
---|