| 1 | IBCRHBS1 ;ALB/ARH - RATES: UPLOAD HOST FILES (RC 2+) SETUP ; 10-OCT-03
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**245**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | HOSTLOAD(VERS) ; upload national REASONABLE CHARGES files from Host files into ^XTMP
|
|---|
| 6 | ;
|
|---|
| 7 | N X,Y,IBFILES,IBPATH,IBFILE,IBNODE,IBOK S IBOK=0,VERS=+$G(VERS)
|
|---|
| 8 | W @IOF,!,"Upload National Reasonable Charges v"_VERS_" Host Files to Temporary Vista files"
|
|---|
| 9 | W !,"--------------------------------------------------------------------------------",!
|
|---|
| 10 | ;
|
|---|
| 11 | S IBPATH=$$PATH I IBPATH<0 G HLEND
|
|---|
| 12 | ;
|
|---|
| 13 | D FILES^IBCRHBRV(.IBFILES,VERS) ; list of files to be loaded
|
|---|
| 14 | ;
|
|---|
| 15 | I '$$FNDHOST(.IBFILES,IBPATH) G HLEND ; all host files found
|
|---|
| 16 | ;
|
|---|
| 17 | I '$$CONT(.IBFILES) G HLEND
|
|---|
| 18 | I '$$CONT1 G HLEND
|
|---|
| 19 | ;
|
|---|
| 20 | W @IOF,!,"Loading National Reasonable Charges v"_VERS_" Host Files into temporary local file"
|
|---|
| 21 | W !,"--------------------------------------------------------------------------------"
|
|---|
| 22 | ;
|
|---|
| 23 | S IBOK=1,IBFILE="" F S IBFILE=$O(IBFILES(IBFILE)) Q:IBFILE="" D I 'IBOK Q
|
|---|
| 24 | . S IBNODE=IBFILES(IBFILE)
|
|---|
| 25 | . I $$LOAD^IBCRHBS2(IBPATH,IBFILE,$P(IBNODE,U,1),$P(IBNODE,U,2),VERS,$P(IBNODE,U,3)) Q
|
|---|
| 26 | . W !!," Error while processing host file, can not continue!",!! S IBOK=0
|
|---|
| 27 | ;
|
|---|
| 28 | I +IBOK W !!,"Upload of Reasonable Charges v"_VERS_" Host Files Complete.",!
|
|---|
| 29 | I +$$FNDXTMP(.IBFILES) D
|
|---|
| 30 | . W !!,"The following files were created in XTMP, they will be purged in 2 days:"
|
|---|
| 31 | . W !,"------------------------------------------------------------------------" D DSPXTMP(.IBFILES)
|
|---|
| 32 | HLEND Q IBOK
|
|---|
| 33 | ;
|
|---|
| 34 | CONT(FILES) ; check for existing files stored in XTMP with same subscript
|
|---|
| 35 | ; returns true if user wants to continue, any existing files are deleted
|
|---|
| 36 | ;
|
|---|
| 37 | N ARR,IBX,IBZ,DIR,DIRUT,DUOUT,X,Y S IBZ=1
|
|---|
| 38 | ;
|
|---|
| 39 | I +$$FNDXTMP(.FILES) D
|
|---|
| 40 | . S IBZ=0 W !!,"These files already exist in XTMP:",!,"----------------------------------"
|
|---|
| 41 | . ;
|
|---|
| 42 | . D DSPXTMP(.FILES,.ARR) Q:$D(ARR)<10 W !
|
|---|
| 43 | . S DIR("?")="Enter either 'Y' or 'N'. These files use the same name as the new upload would use and therefore must be deleted before the upload can proceed."
|
|---|
| 44 | . S DIR("A")="Delete the above files and continue with the upload",DIR(0)="Y" D ^DIR K DIR
|
|---|
| 45 | . ;
|
|---|
| 46 | . I Y=1 S IBZ=1,IBX="IBCR RC" F S IBX=$O(^XTMP(IBX)) Q:IBX'["IBCR RC" K ^XTMP(IBX) W "."
|
|---|
| 47 | ;
|
|---|
| 48 | Q IBZ
|
|---|
| 49 | ;
|
|---|
| 50 | CONT1() ; get final OK to start upload, return true if want to continue with upload
|
|---|
| 51 | N IBZ,DIR,DIRUT,DUOUT,X,Y S IBZ=0 W !!
|
|---|
| 52 | S DIR("?")="Enter either 'Y' or 'N'. Enter 'Y' if you want to load the Reasonable Charges Host files into XTMP."
|
|---|
| 53 | S DIR("A")="Proceed with upload of National Reasonable Charges Host Files now",DIR(0)="Y" D ^DIR K DIR I Y=1 S IBZ=1
|
|---|
| 54 | Q IBZ
|
|---|
| 55 | ;
|
|---|
| 56 | PATH() ; return directory or -1
|
|---|
| 57 | N IBPATH,DIR,DIRUT,DUOUT,X,Y S IBPATH=""
|
|---|
| 58 | S DIR("?",1)="Enter the full path specification where the host files may be found"
|
|---|
| 59 | S DIR("?")="or press return for the default directory "_$$PWD^%ZISH
|
|---|
| 60 | S DIR(0)="FO^3:60",DIR("A")="Enter the file path",DIR("B")=$$PWD^%ZISH D ^DIR K DIR
|
|---|
| 61 | S IBPATH=$S($D(DUOUT)!$D(DTOUT):-1,1:Y)
|
|---|
| 62 | Q IBPATH
|
|---|
| 63 | ;
|
|---|
| 64 | FNDXTMP(FILES) ; find if any existing files in XTMP, return true if any found
|
|---|
| 65 | N IBFILE,IBXRF,IBNODE,IBZ S IBZ=0
|
|---|
| 66 | ;
|
|---|
| 67 | S IBFILE="" F S IBFILE=$O(FILES(IBFILE)) Q:IBFILE="" D Q:+IBZ
|
|---|
| 68 | . S IBXRF="IBCR RC "_$P(FILES(IBFILE),U,2) Q:$D(^XTMP(IBXRF))=0 S IBZ=1
|
|---|
| 69 | Q IBZ
|
|---|
| 70 | ;
|
|---|
| 71 | DSPXTMP(FILES,ARR) ; display any existing files in XTMP, ARR passed by ref can be used to get list of existing file subscripts
|
|---|
| 72 | N IBFILE,IBXRF,IBNODE,IBY K ARR
|
|---|
| 73 | ;
|
|---|
| 74 | S IBFILE="" F S IBFILE=$O(FILES(IBFILE)) Q:IBFILE="" D
|
|---|
| 75 | . S IBXRF="IBCR RC "_$P(FILES(IBFILE),U,2) I $D(^XTMP(IBXRF))=0 Q
|
|---|
| 76 | . S ARR(IBXRF)="",IBNODE=$G(^XTMP(IBXRF,0)),IBY=$S($P(IBNODE,U,3)="":IBXRF,1:$P(IBNODE,U,3))
|
|---|
| 77 | . W !,?4,$E(IBY,1,67),?74,$P(IBNODE,U,5)
|
|---|
| 78 | Q
|
|---|
| 79 | ;
|
|---|
| 80 | FNDHOST(FILES,IBPATH) ; find and display any Host files available for upload, return true if all required files found
|
|---|
| 81 | N IBX,IBY,IBZ,IBF,IBFILE,X,Y S IBF=1
|
|---|
| 82 | W !!,"Reasonable Charges Host Files found: ",?44,IBPATH,!,"------------------------------------"
|
|---|
| 83 | ;
|
|---|
| 84 | I $O(FILES(""))="" S IBF=0
|
|---|
| 85 | ;
|
|---|
| 86 | S IBFILE="" F S IBFILE=$O(FILES(IBFILE)) Q:IBFILE="" D
|
|---|
| 87 | . S IBX(IBFILE)="",IBZ=$$LIST^%ZISH(IBPATH,"IBX","IBY") K IBX,IBY
|
|---|
| 88 | . W !,$P(FILES(IBFILE),U,1),":",?45,IBFILE I 'IBZ W ?57,"*** not found ***" S IBF=0
|
|---|
| 89 | ;
|
|---|
| 90 | I 'IBF W !!,"Can not find all required host files, can not continue!",!!
|
|---|
| 91 | I +IBF W !!,"All required host files found.",!
|
|---|
| 92 | Q IBF
|
|---|
