Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCRHBC

IBCRHBC.m

Go to the documentation of this file. 
  1. IBCRHBC ;ALB/ARH - RATES: UPLOAD HOST FILES (CMAC DRIVER) ; 22-MAY-1996
  1.  ;;2.0;INTEGRATED BILLING;**52,106,124,307**;21-MAR-94
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1.  ; USER SELECT FILE, DETERMINE FILE TYPE/FORMAT, CALL LOAD ROUTINE
  1.  ;
  1. CMAC ; OPTION: upload a CMAC file from a VMS file into ^XTMP
  1.  N IBPATH,IBFILE,IBNAME,IBMODP,IBMODT,IBFLINE,IBFORM,IBDONE,IBGLBEFF S IBDONE=""
  1.  ;
  1.  S IBNAME="IBCR UPLOAD " I '$$CONT(IBNAME) Q
  1.  ;
  1.  W !!,"Upload CMAC Host File:  'CMACxxx.TXT' or 'yyyyCMACxxx.TXT'  w/xxx = locality",!
  1.  ;
  1.  S IBPATH=$$PATH I IBPATH<0 Q
  1.  I '$$FNDHOST(IBPATH) Q
  1.  ;
  1.  S IBFILE=$$FILE Q:IBFILE=""
  1.  ;
  1.  S IBMODP=$$MOD("","Professional") I IBMODP<0 Q
  1.  S IBMODT=$$MOD("","Technical") I IBMODT<0 Q
  1.  ;
  1.  D OPEN^%ZISH("CMAC UPLOAD",IBPATH,IBFILE,"R") I POP W !!,"**** Unable to open ",IBPATH,IBFILE,! Q
  1.  ;
  1.  U IO R IBFLINE:5
  1.  ;
  1.  D CLOSE^%ZISH("CMAC UPLOAD")
  1.  ;
  1.  S IBFORM=$$CHKF(IBFLINE,IBFILE) Q:'IBFORM
  1.  ;
  1.  W !!,?14,"File: ",IBFILE,?40,"Effective: ",$$DATE(IBFORM,IBFLINE)
  1.  I '$$CONT1 Q
  1.  ;
  1.  I IBFORM=1 S IBDONE=$$CMAC^IBCRHBC1(IBPATH,IBFILE,IBNAME,IBMODP,IBMODT)
  1.  I IBFORM=2 S IBDONE=$$CMAC^IBCRHBC2(IBPATH,IBFILE,IBNAME,IBMODP,IBMODT)
  1.  I IBFORM=3 S IBDONE=$$CMAC^IBCRHBC3(IBPATH,IBFILE,IBNAME,IBMODP,IBMODT)
  1.  ;
  1.  W !!,"Done. ",$P(IBDONE,U,1)," lines processed."
  1.  W !,"The following files were created, they will be purged in 2 days:" D DISP1^IBCRHU1($P(IBDONE,U,2))
  1.  Q
  1.  ;
  1. CHKF(LINE,FILE) ; check that first line of file fits one of the three formats, if it does return the format type, otherwise 0
  1.  N IBX,IBY S LINE=$G(LINE),FILE=$G(FILE),IBX=0
  1.  S IBY="**** Error reading file: not expected format (85, 91 or 98 numeric characters):"
  1.  ;
  1.  I (FILE'?1"CMAC"3N1".TXT"),(FILE'?4N1"CMAC"3N1".TXT") W !!,IBY,!!,"Bad file name, can not continue!" G CHKFQ
  1.  I LINE="" W !!,IBY,!!,"First line of file is null, can not continue!" G CHKFQ
  1.  ; 
  1.  I $$LNFORM^IBCRHBC1(LINE) S IBX=1 G CHKFQ
  1.  I $$LNFORM^IBCRHBC2(LINE) S IBX=2 G CHKFQ
  1.  I $$LNFORM^IBCRHBC3(LINE) S IBX=3 G CHKFQ
  1.  ;
  1.  W !!,IBY,!,"Line Length=",$L(LINE)," characters",!!,"LINE='",LINE,"'",!!,"Can not Continue!"
  1.  ;
  1. CHKFQ Q IBX
  1.  ;
  1. CONT(XREF) ; check for existing files stored in XREF with same host file name
  1.  ; returns true if user wants to continue and these files are deleted
  1.  ;
  1.  N ARR,IBX,IBY,IBZ,DIR,DIRUT,DUOUT,X,Y S XREF=$G(XREF),ARR=0,IBZ=1 W !
  1.  ;
  1.  D DISP1^IBCRHU1(XREF,.ARR)
  1.  ;
  1.  I +ARR S IBZ=0 D  W !
  1.  . W !!,"The above files already exist in XTMP." S DIR("?")="Enter either 'Y' or 'N'.  These files use the same names as the new upload would use, and therefore must be deleted before the upload can proceed."
  1.  . S DIR("A")="Delete the above files and continue with upload",DIR(0)="Y" D ^DIR K DIR
  1.  . ;
  1.  . I Y=1 S IBZ=1,IBX="" F  S IBX=$O(ARR(IBX)) Q:IBX=""  K ^XTMP(IBX) W "."
  1.  ;
  1.  Q IBZ
  1.  ;
  1. MOD(DEFAULT,NAME) ; get the modifiers to use with the professional and technical component charges
  1.  ;
  1.  N IBX,DIR,DIRUT,DUOUT,DTOUT,X,Y S IBX=""
  1.  S DIR("?",1)="Some procedures have charges broken into professional and technical components."
  1.  S DIR("?",2)="To bill these components a CPT Modifier must be added with the CPT."
  1.  S DIR("?",3)="If no modifier is entered the "_NAME_" Component charges will not be uploaded."
  1.  S DIR("?")="Enter the CPT Modifier that should be used for every "_NAME_" component charge.",DIR("?",4)=""
  1.  ;
  1.  S DIR("A")=NAME_" Component Modifier",DIR("B")=$G(DEFAULT)
  1.  S DIR(0)="PO^DIC(81.3," D ^DIR K DIR I Y>0 S IBX=+Y
  1.  I $D(DUOUT)!$D(DTOUT) S IBX=-1
  1.  I 'IBX W !!,?7,NAME," Component charges will not be uploaded.",!
  1.  ;
  1.  Q IBX
  1.  ;
  1. CONT1() ; get final OK to start upload
  1.  N IBZ,DIR,DIRUT,DUOUT,X,Y S IBZ=0 W !
  1.  S DIR("A")="Proceed with upload now",DIR(0)="Y" D ^DIR K DIR I Y=1 S IBZ=1
  1.  Q IBZ
  1.  ;
  1. PATH() ; return directory or -1
  1.  N IBPATH,DIR,DIRUT,DUOUT,X,Y S IBPATH=""
  1.  S DIR("?",1)="Enter the full path specification where the host files may be found"
  1.  S DIR("?")="or press return for the default directory "_$$PWD^%ZISH
  1.  S DIR(0)="FO^3:60",DIR("A")="Enter the file path",DIR("B")=$$PWD^%ZISH D ^DIR K DIR
  1.  S IBPATH=$S($D(DUOUT)!$D(DTOUT):-1,1:Y)
  1.  Q IBPATH
  1.  ;
  1. FNDHOST(IBPATH) ; find and display any host files available for upload: 1 if some, 0 none found
  1.  N IBX,IBY,IBZ,IBI,IBCYR,X,Y S IBPATH=$G(IBPATH),IBZ=0
  1.  ;
  1.  S IBX("CMAC*")="",IBCYR=$S($E(DT)=2:19,1:20)_$E(DT,2,3) F IBI=IBCYR:-1:(IBCYR-10) S IBX(IBI_"CMAC*")=""
  1.  ;
  1.  W !,"CMAC Host files available for upload in: ",IBPATH,!!
  1.  S IBZ=$$LIST^%ZISH(IBPATH,"IBX","IBY")
  1.  I 'IBZ W "**** No CMAC files found ",IBPATH,"CMACxxx.TXT or yyyyCMACxxx.TXT, can not continue.",!
  1.  I +IBZ S IBX="" F  S IBX=$O(IBY(IBX)) Q:IBX=""  W ?30,$P(IBX,";",1),!
  1.  Q IBZ
  1.  ;
  1. FILE() ; get name of file to be loaded, returns null or file name in 'CMACxxx.TXT' or 'yyyyCMACxxx.TXT' format
  1.  N DIR,DIRUT,DUOUT,DTOUT,X,Y,IBX,IBY S (IBY,IBX)=""
  1.  S DIR("?")="Enter a CMAC Host File Name of format: 'CMACxxx.TXT' or 'yyyyCMACxxx.TXT'  w/xxx = locality and w/yyyy = year charges effective"
  1.  S DIR(0)="FO^3:60",DIR("A")="Enter a Host File Name" D ^DIR K DIR I '$D(DIRUT) S IBY=Y
  1.  ;
  1.  I IBY'="",($E(IBY,1,4)="CMAC"),($E(IBY,5,7)?3N),($E(IBY,8,999)=".TXT") S IBX=IBY
  1.  I IBY'="",($E(IBY,1,4)?4N),($E(IBY,5,8)="CMAC"),($E(IBY,9,11)?3N),($E(IBY,12,999)=".TXT") S IBX=IBY
  1.  ;
  1.  I IBY'="",IBX="" W !!,"**** File not a CMAC file: must be 'CMACxxx.TXT' or 'yyyyCMACxxx.TXT'.",!
  1.  ;
  1.  Q IBX
  1.  ;
  1. DATE(FORM,LINE) ; return file formated date in FM format, returns null or file date in FM format
  1.  N IBX S LINE=$G(LINE),FORM=$G(FORM),(IBGLBEFF,IBX)=""
  1.  I FORM=1 S IBX=$$LNDT^IBCRHBC1(LINE)
  1.  I FORM=2 S IBX=$$LNDT^IBCRHBC2(LINE)
  1.  I FORM=3 S IBX=$$LNDT^IBCRHBC3(LINE)
  1.  I IBX'="" S IBGLBEFF=IBX,IBX=$$FMTE^XLFDT(IBX)
  1.  Q IBX