source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXBPMOD.m@ 1211

Last change on this file since 1211 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1PXBPMOD ;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 ;
8MOD(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 ;
40FILECPT ;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 ;
55CPTMOD ;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 ;
76BLDARRY ;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 ;
85VALCPT(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
Note: See TracBrowser for help on using the repository browser.