- 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 Jan 18, 2025@03:21:19 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