IBCRHD ;ALB/ARH - RATES: UPLOAD ASSIGN & DELETE ; 22-MAY-1996
;;2.0;INTEGRATED BILLING;**52,106,115**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
ACS ; OPTION: assign Charge Sets to existing XTMP files
;
N DIR,DIRUT,DTOUT,DUOUT,X,Y,IBX,IBA1,IBA2,IBFILE,IBCS,IBBI1,IBBI2
W !!,"Assign charges loaded into XTMP to Charge Sets.",!
;
ACS1 W !,"------------------------------------------------------------------------------"
D DISP1^IBCRHU1("",.IBA1,.IBA2) I 'IBA1 W !,"No files in XTMP." Q
;
S DIR("A")="Assign Charge Set to which file",DIR(0)="NO^1:"_+IBA1 D ^DIR K DIR I 'Y!$D(DIRUT) Q
S IBFILE=IBA2(+Y) Q:IBFILE="" W !!,?5,$P(IBFILE,U,1),?40,$P(IBFILE,U,2),!
;
S IBCS=$$GETCS^IBCRU1 I IBCS<0 G ACS1
;
I +IBCS W !!,?7,"Charge Set: ",$P($G(^IBE(363.1,+IBCS,0)),U,1),?45,"Billable Item: ",$P($$CSBI^IBCRU3(+IBCS),U,2),!
I +IBCS S IBX=$$CHKFL^IBCRHU1(IBCS,$P(IBFILE,U,1),$P(IBFILE,U,2)) I +IBX D EOP G ACS1
I 'IBCS W !!,"Charge Set will be removed from the file."
;
I $D(^XTMP($P(IBFILE,U,1),$P(IBFILE,U,2))) S $P(^XTMP($P(IBFILE,U,1),$P(IBFILE,U,2)),U,3)=+IBCS
G ACS1
Q
;
DEL ; OPTION: delete files in XTMP
;
N DIR,DIRUT,DTOUT,DUOUT,X,Y,IBX,IBA2,IBA3,IBFILES,IBI,IBF1,IBF2
W !!,"Delete files in XTMP:"
W !,"------------------------------------------------------------------------------"
D DISP1^IBCRHU1("","",.IBA2) I 'IBA2 W !,"No files in XTMP." Q
;
S DIR("A")="Delete which files",DIR(0)="LO^1:"_+IBA2 D ^DIR K DIR I 'Y!$D(DIRUT) Q
;
S IBFILES=Y F IBI=1:1 S IBF1=$P(IBFILES,",",IBI) Q:'IBF1 S IBA3(IBF1)=$G(IBA2(IBF1)),IBA3=+$G(IBA3)+1
I 'IBA3 W !,"No files selected.",! Q
;
W !!,"The following files will be deleted:",!!
S IBI=0 F S IBI=$O(IBA3(IBI)) Q:'IBI W $P(IBA3(IBI),U,1),?40,$P(IBA3(IBI),U,2),!
I '$$CONT W !,"No change." Q
;
; delete selected XTMP files
S IBI=0 F S IBI=$O(IBA3(IBI)) Q:'IBI D
. S IBF1=$P(IBA3(IBI),U,1),IBF2=$P(IBA3(IBI),U,2) I (IBF1="")!(IBF2="") Q
. K ^XTMP(IBF1,IBF2) W !,IBF1,?40,IBF2,?65,"... deleted."
. I $O(^XTMP(IBF1,0))="" K ^XTMP(IBF1) W !,IBF1,?65,"... deleted.",!
;
; delete National Reasonable Charges XTMP files if after delete date
S IBF1="IBCR RC",IBI=$O(^XTMP(IBF1)) I IBI[IBF1 D
. S IBX=$G(^XTMP(IBI,0)) I DT'>+IBX Q
. W !!,"Deleting Reasonable Charges XTMP files",!,"uploaded from Host Files on ",$$FMTE^XLFDT($P(IBX,U,2))
. S IBI=IBF1 F S IBI=$O(^XTMP(IBI)) Q:IBI'[IBF1 K ^XTMP(IBI) W "."
W !!
Q
;
CONT() ; continue y/n
N IBZ,DIR,DIRUT,DTOUT,DUOUT,X,Y S IBZ=0
S DIR("A")="Is this correct, do you want to continue",DIR(0)="Y" D ^DIR K DIR I Y=1 S IBZ=1 W !
Q IBZ
;
EOP ; continue at end of page of display
N DIR,DIRUT,DTOUT,DUOUT,X,Y W !,"*** ",$P($P(IBX,U,2),")",1),")",!,?16,$P($P(IBX,U,2),")",2,99),!
S DIR(0)="E" D ^DIR K DIR W !
Q
;
OPTION ; OPTION: MAIN ENTRY POINT FOR LOADING FILES INTO THE CHARGE MASTER
;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
;
UP1 S DIR(0)="SO^1.1:Load CMAC into XTMP;1.2:Load AWP into XTMP;1.3:Load RC into XTMP;1.4:Load TP into XTMP;2:Assign Charge Set;3:Check Data Validity;4:Load into Charge Master;5:Delete XTMP files"
D ^DIR K DIR I 'Y!$D(DIRUT) Q
;
I +Y=1.1 D CMAC^IBCRHBC G UP1
I +Y=1.2 D AWP^IBCRHBA G UP1
I +Y=1.3 D RC^IBCRHBR G UP1
I +Y=1.4 D TP^IBCRHBT G UP1
I +Y=2 D ACS^IBCRHD G UP1
I +Y=3 D ENTRY^IBCRHO(0) G UP1
I +Y=4 D ENTRY^IBCRHO(1) G UP1
I +Y=5 D DEL^IBCRHD G UP1
Q
;
;
; Format of XTMP file created from host files to load into Charge Master:
; ^XTMP(XRF1, 0) = delete DT ^ loaded DT ^ Name, time, user ^ total count
; ^XTMP(XRF1, XRF2) = subfile count ^ billable item type ^ Charge Set (added by user)
; ^XTMP(XRF1, XRF2, x) = item ptr ^ eff dt ^ inactive dt ^ $ charge ^ modifier ptr
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCRHD 3790 printed Apr 09, 2024@21:14:21 Page 2
IBCRHD ;ALB/ARH - RATES: UPLOAD ASSIGN & DELETE ; 22-MAY-1996
+1 ;;2.0;INTEGRATED BILLING;**52,106,115**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
ACS ; OPTION: assign Charge Sets to existing XTMP files
+1 ;
+2 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y,IBX,IBA1,IBA2,IBFILE,IBCS,IBBI1,IBBI2
+3 WRITE !!,"Assign charges loaded into XTMP to Charge Sets.",!
+4 ;
ACS1 WRITE !,"------------------------------------------------------------------------------"
+1 DO DISP1^IBCRHU1("",.IBA1,.IBA2)
IF 'IBA1
WRITE !,"No files in XTMP."
QUIT
+2 ;
+3 SET DIR("A")="Assign Charge Set to which file"
SET DIR(0)="NO^1:"_+IBA1
DO ^DIR
KILL DIR
IF 'Y!$DATA(DIRUT)
QUIT
+4 SET IBFILE=IBA2(+Y)
if IBFILE=""
QUIT
WRITE !!,?5,$PIECE(IBFILE,U,1),?40,$PIECE(IBFILE,U,2),!
+5 ;
+6 SET IBCS=$$GETCS^IBCRU1
IF IBCS<0
GOTO ACS1
+7 ;
+8 IF +IBCS
WRITE !!,?7,"Charge Set: ",$PIECE($GET(^IBE(363.1,+IBCS,0)),U,1),?45,"Billable Item: ",$PIECE($$CSBI^IBCRU3(+IBCS),U,2),!
+9 IF +IBCS
SET IBX=$$CHKFL^IBCRHU1(IBCS,$PIECE(IBFILE,U,1),$PIECE(IBFILE,U,2))
IF +IBX
DO EOP
GOTO ACS1
+10 IF 'IBCS
WRITE !!,"Charge Set will be removed from the file."
+11 ;
+12 IF $DATA(^XTMP($PIECE(IBFILE,U,1),$PIECE(IBFILE,U,2)))
SET $PIECE(^XTMP($PIECE(IBFILE,U,1),$PIECE(IBFILE,U,2)),U,3)=+IBCS
+13 GOTO ACS1
+14 QUIT
+15 ;
DEL ; OPTION: delete files in XTMP
+1 ;
+2 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y,IBX,IBA2,IBA3,IBFILES,IBI,IBF1,IBF2
+3 WRITE !!,"Delete files in XTMP:"
+4 WRITE !,"------------------------------------------------------------------------------"
+5 DO DISP1^IBCRHU1("","",.IBA2)
IF 'IBA2
WRITE !,"No files in XTMP."
QUIT
+6 ;
+7 SET DIR("A")="Delete which files"
SET DIR(0)="LO^1:"_+IBA2
DO ^DIR
KILL DIR
IF 'Y!$DATA(DIRUT)
QUIT
+8 ;
+9 SET IBFILES=Y
FOR IBI=1:1
SET IBF1=$PIECE(IBFILES,",",IBI)
if 'IBF1
QUIT
SET IBA3(IBF1)=$GET(IBA2(IBF1))
SET IBA3=+$GET(IBA3)+1
+10 IF 'IBA3
WRITE !,"No files selected.",!
QUIT
+11 ;
+12 WRITE !!,"The following files will be deleted:",!!
+13 SET IBI=0
FOR
SET IBI=$ORDER(IBA3(IBI))
if 'IBI
QUIT
WRITE $PIECE(IBA3(IBI),U,1),?40,$PIECE(IBA3(IBI),U,2),!
+14 IF '$$CONT
WRITE !,"No change."
QUIT
+15 ;
+16 ; delete selected XTMP files
+17 SET IBI=0
FOR
SET IBI=$ORDER(IBA3(IBI))
if 'IBI
QUIT
Begin DoDot:1
+18 SET IBF1=$PIECE(IBA3(IBI),U,1)
SET IBF2=$PIECE(IBA3(IBI),U,2)
IF (IBF1="")!(IBF2="")
QUIT
+19 KILL ^XTMP(IBF1,IBF2)
WRITE !,IBF1,?40,IBF2,?65,"... deleted."
+20 IF $ORDER(^XTMP(IBF1,0))=""
KILL ^XTMP(IBF1)
WRITE !,IBF1,?65,"... deleted.",!
End DoDot:1
+21 ;
+22 ; delete National Reasonable Charges XTMP files if after delete date
+23 SET IBF1="IBCR RC"
SET IBI=$ORDER(^XTMP(IBF1))
IF IBI[IBF1
Begin DoDot:1
+24 SET IBX=$GET(^XTMP(IBI,0))
IF DT'>+IBX
QUIT
+25 WRITE !!,"Deleting Reasonable Charges XTMP files",!,"uploaded from Host Files on ",$$FMTE^XLFDT($PIECE(IBX,U,2))
+26 SET IBI=IBF1
FOR
SET IBI=$ORDER(^XTMP(IBI))
if IBI'[IBF1
QUIT
KILL ^XTMP(IBI)
WRITE "."
End DoDot:1
+27 WRITE !!
+28 QUIT
+29 ;
CONT() ; continue y/n
+1 NEW IBZ,DIR,DIRUT,DTOUT,DUOUT,X,Y
SET IBZ=0
+2 SET DIR("A")="Is this correct, do you want to continue"
SET DIR(0)="Y"
DO ^DIR
KILL DIR
IF Y=1
SET IBZ=1
WRITE !
+3 QUIT IBZ
+4 ;
EOP ; continue at end of page of display
+1 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
WRITE !,"*** ",$PIECE($PIECE(IBX,U,2),")",1),")",!,?16,$PIECE($PIECE(IBX,U,2),")",2,99),!
+2 SET DIR(0)="E"
DO ^DIR
KILL DIR
WRITE !
+3 QUIT
+4 ;
OPTION ; OPTION: MAIN ENTRY POINT FOR LOADING FILES INTO THE CHARGE MASTER
+1 ;
+2 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+3 ;
UP1 SET DIR(0)="SO^1.1:Load CMAC into XTMP;1.2:Load AWP into XTMP;1.3:Load RC into XTMP;1.4:Load TP into XTMP;2:Assign Charge Set;3:Check Data Validity;4:Load into Charge Master;5:Delete XTMP files"
+1 DO ^DIR
KILL DIR
IF 'Y!$DATA(DIRUT)
QUIT
+2 ;
+3 IF +Y=1.1
DO CMAC^IBCRHBC
GOTO UP1
+4 IF +Y=1.2
DO AWP^IBCRHBA
GOTO UP1
+5 IF +Y=1.3
DO RC^IBCRHBR
GOTO UP1
+6 IF +Y=1.4
DO TP^IBCRHBT
GOTO UP1
+7 IF +Y=2
DO ACS^IBCRHD
GOTO UP1
+8 IF +Y=3
DO ENTRY^IBCRHO(0)
GOTO UP1
+9 IF +Y=4
DO ENTRY^IBCRHO(1)
GOTO UP1
+10 IF +Y=5
DO DEL^IBCRHD
GOTO UP1
+11 QUIT
+12 ;
+13 ;
+14 ; Format of XTMP file created from host files to load into Charge Master:
+15 ; ^XTMP(XRF1, 0) = delete DT ^ loaded DT ^ Name, time, user ^ total count
+16 ; ^XTMP(XRF1, XRF2) = subfile count ^ billable item type ^ Charge Set (added by user)
+17 ; ^XTMP(XRF1, XRF2, x) = item ptr ^ eff dt ^ inactive dt ^ $ charge ^ modifier ptr
