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