| 1 | IBCSC8A ;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 | ;
|
|---|
| 5 | EN ;
|
|---|
| 6 | N DAM,DIT,EC,LXD,OK,PCC,PCCI,UO,UR
|
|---|
| 7 | S UO="UNSPECIFIED [OPTIONAL]",UR="UNSPECIFIED [REQUIRED]"
|
|---|
| 8 | S EC="000"
|
|---|
| 9 | EN1 ;
|
|---|
| 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 | ;
|
|---|
| 20 | DISP ; 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 | ;
|
|---|
| 30 | EDIT ; 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 | ;
|
|---|
| 49 | CHK ; 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
|
|---|
| 60 | DSPERR ; 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
|
|---|
