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