source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCSC8A.m@ 767

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

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1IBCSC8A ;BP/YMG - ADD/ENTER CHIROPRACTIC DATA ;06/08/2007
2 ;;2.0;INTEGRATED BILLING;**371**;21-MAR-94;Build 57
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5EN ;
6 N DAM,DIT,EC,LXD,OK,PCC,PCCI,UO,UR
7 S UO="UNSPECIFIED [OPTIONAL]",UR="UNSPECIFIED [REQUIRED]"
8 S EC="000"
9EN1 ;
10 S OK=1
11 S DIT=$$GET1^DIQ(399,IBIFN,246) S:DIT="" DIT=UR
12 S PCCI=$P($G(^DGCR(399,IBIFN,"U3")),U,7)
13 S PCC=$S(PCCI'="":PCCI_" ("_$$EXTERNAL^DILFD(399,248,"",PCCI)_")",1:UR)
14 S DAM=$$GET1^DIQ(399,IBIFN,247) S:DAM="" DAM=$S("AM"'[PCCI!(PCCI=""):UO,1:UR)
15 S LXD=$$GET1^DIQ(399,IBIFN,245) S:LXD="" LXD=UO
16 D DISP,EDIT G:'OK EN1
17 D CLEAN^DILF
18 Q
19 ;
20DISP ; display existing values
21 W @IOF,!,"============================= CHIROPRACTIC DATA ==============================",!
22 D:+EC DSPERR
23 W !!,?3,"---------------------- Current values for Bill -----------------------",!
24 W !,?3,"Date of initial treatment : ",DIT
25 W !,?3,"Patient condition code : ",PCC
26 W !,?3,"Date of acute manifestation : ",DAM
27 W !,?3,"Last x-ray date : ",LXD,!
28 Q
29 ;
30EDIT ; edit data
31 N DEL,TOUT,UOUT
32 S DIE="^DGCR(399,",DR="246;248;247;245",DA=IBIFN D ^DIE S TOUT=$D(DTOUT),UOUT=$D(Y) K DIE,DR,DA D CHK
33 ; if all data is valid, we are done here
34 Q:'+EC
35 ; we get here if:
36 ; - all prompts have been answered, but data is invalid, or
37 ; - editing was interrupted by user ("^" exit), or
38 ; - editing timed out
39 ;
40 ;if "^"-exit and user doesn't want to discard data, or all prompts answered, go back to the same screen
41 I 'TOUT S DEL=1 D I DEL=0!('UOUT) S OK=0 Q
42 .; if "^"-exit, ask if data should be discarded
43 .I UOUT S DIR(0)="Y",DIR("A")="Delete Chiropractic Data",DIR("B")="YES" D ^DIR S DEL=$G(Y) K DIR
44 .Q
45 ; if user requested to delete data or entry prompt timed out, clear out chiro fields
46 S DIE="^DGCR(399,",DR="246///@;248///@;247///@;245///@",DA=IBIFN D ^DIE K DIE,DR,DA
47 Q
48 ;
49CHK ; check data integrity
50 ; sets 3 char error code in EC, each position containing 0 means no error
51 ; positions containing 1 trigger the following errors:
52 ; position 1 - Date of Initial Treatment is missing
53 ; position 2 - Patient Condition Code is missing
54 ; position 3 - Date of Acute manifestation is missing (for Patient Condition Code = A or M)
55 N IBX,PCC
56 S IBX=$P($G(^DGCR(399,IBIFN,"U3")),U,4,7),EC="000"
57 ; chiropractic claim if any of the fields are populated
58 S:$TR(IBX,U)'="" PCC=$P(IBX,U,4),$E(EC,1)=($P(IBX,U,2)=""),$E(EC,2)=(PCC=""),$E(EC,3)=($P(IBX,U,3)=""&(PCC]"")&("AM"[PCC))
59 Q
60DSPERR ; display errors
61 W !,?3,"Errors detected:"
62 W:+$E(EC,1) !,?5,"Date of Initial Treatment is required"
63 W:+$E(EC,2) !,?5,"Patient Condition Code is required"
64 W:+$E(EC,3) !,?5,"Condition code A or M requires Date of Acute Manifestation"
65 Q
Note: See TracBrowser for help on using the repository browser.