source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCRHD.m@ 1000

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