Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCSC10A

IBCSC10A.m

Go to the documentation of this file.
  1. IBCSC10A ;BP/YMG - ADD/ENTER CHIROPRACTIC DATA ;06/08/2007
  1. ;;2.0;INTEGRATED BILLING;**432**;21-MAR-94;Build 192
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; DEM;432 - Moved IBCSC8* billing screen routines to IBCSC10* billing screen
  1. ; routines and created a new billing screen 8 routine IBCSC8.
  1. ;
  1. EN ;
  1. N DAM,DIT,EC,LXD,OK,PCC,PCCI,UO,UR
  1. S UO="UNSPECIFIED [OPTIONAL]",UR="UNSPECIFIED [REQUIRED]"
  1. S EC="000"
  1. EN1 ;
  1. S OK=1
  1. S DIT=$$GET1^DIQ(399,IBIFN,246) S:DIT="" DIT=UR
  1. S PCCI=$P($G(^DGCR(399,IBIFN,"U3")),U,7)
  1. S PCC=$S(PCCI'="":PCCI_" ("_$$EXTERNAL^DILFD(399,248,"",PCCI)_")",1:UR)
  1. S DAM=$$GET1^DIQ(399,IBIFN,247) S:DAM="" DAM=$S("AM"'[PCCI!(PCCI=""):UO,1:UR)
  1. S LXD=$$GET1^DIQ(399,IBIFN,245) S:LXD="" LXD=UO
  1. D DISP,EDIT G:'OK EN1
  1. D CLEAN^DILF
  1. Q
  1. ;
  1. DISP ; display existing values
  1. W @IOF,!,"============================= CHIROPRACTIC DATA ==============================",!
  1. D:+EC DSPERR
  1. W !!,?3,"---------------------- Current values for Bill -----------------------",!
  1. W !,?3,"Date of initial treatment : ",DIT
  1. W !,?3,"Patient condition code : ",PCC
  1. W !,?3,"Date of acute manifestation : ",DAM
  1. W !,?3,"Last x-ray date : ",LXD,!
  1. Q
  1. ;
  1. EDIT ; edit data
  1. N DEL,TOUT,UOUT
  1. 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
  1. ; if all data is valid, we are done here
  1. Q:'+EC
  1. ; we get here if:
  1. ; - all prompts have been answered, but data is invalid, or
  1. ; - editing was interrupted by user ("^" exit), or
  1. ; - editing timed out
  1. ;
  1. ;if "^"-exit and user doesn't want to discard data, or all prompts answered, go back to the same screen
  1. I 'TOUT S DEL=1 D I DEL=0!('UOUT) S OK=0 Q
  1. .; if "^"-exit, ask if data should be discarded
  1. .I UOUT S DIR(0)="Y",DIR("A")="Delete Chiropractic Data",DIR("B")="YES" D ^DIR S DEL=$G(Y) K DIR
  1. .Q
  1. ; if user requested to delete data or entry prompt timed out, clear out chiro fields
  1. S DIE="^DGCR(399,",DR="246///@;248///@;247///@;245///@",DA=IBIFN D ^DIE K DIE,DR,DA
  1. Q
  1. ;
  1. CHK ; check data integrity
  1. ; sets 3 char error code in EC, each position containing 0 means no error
  1. ; positions containing 1 trigger the following errors:
  1. ; position 1 - Date of Initial Treatment is missing
  1. ; position 2 - Patient Condition Code is missing
  1. ; position 3 - Date of Acute manifestation is missing (for Patient Condition Code = A or M)
  1. N IBX,PCC
  1. S IBX=$P($G(^DGCR(399,IBIFN,"U3")),U,4,7),EC="000"
  1. ; chiropractic claim if any of the fields are populated
  1. 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))
  1. Q
  1. DSPERR ; display errors
  1. W !,?3,"Errors detected:"
  1. W:+$E(EC,1) !,?5,"Date of Initial Treatment is required"
  1. W:+$E(EC,2) !,?5,"Patient Condition Code is required"
  1. W:+$E(EC,3) !,?5,"Condition code A or M requires Date of Acute Manifestation"
  1. Q