IBJPS5 ;BP/VAD - IB Site Parameters, Revenue Codes ; 19-AUG-2015
;;2.0;INTEGRATED BILLING;**547**;21-MAR-94;Build 119
;;Per VA Directive 6402, this routine should not be modified.
;
EN ; -- main entry point for IBJP IB REVENUE CODES
D EN^VALM("IBJP IB REVENUE CODES")
Q
;
HDR ; -- header code
S VALMSG=""
Q
;
INIT ; INIT-- init variables and list array
N ERROR,IBCNT,IBLN,IBSTR,REVDATA,RIENS,RVCD,RVDSC
;
S (VALMCNT,IBCNT,IBLN)=0
I $D(^IBE(350.9,1,15,"B")) D
. S RVCD=0 F S RVCD=$O(^IBE(350.9,1,15,"B",RVCD)) Q:'RVCD D
. . ;
. . S RIENS=RVCD_","
. . D GETS^DIQ(399.2,RIENS,".01;1;2","I","REVDATA","ERROR")
. . ; do not included *RESERVED codes (must be ACTIVATE = 1 for Activated)
. . Q:$G(REVDATA(399.2,RIENS,2,"I"))'=1
. . S IBCNT=IBCNT+1
. . S IBSTR=$$SETSTR^VALM1($J(IBCNT,4)_".","",2,6)
. . S IBSTR=$$SETSTR^VALM1($J($G(REVDATA(399.2,RIENS,.01,"I")),3),IBSTR,10,4)
. . S IBSTR=$$SETSTR^VALM1($G(REVDATA(399.2,RIENS,1,"I")),IBSTR,17,30)
. . S IBLN=$$SET(IBLN,IBSTR)
. . S @VALMAR@("ZIDX",IBCNT,$G(REVDATA(399.2,RIENS,.01,"I")))=""
. . Q
;
I 'IBLN S IBLN=$$SET(IBLN,$$SETSTR^VALM1("No Revenue Codes defined.","",13,40))
;
S VALMCNT=IBLN,VALMBG=1
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
D CLEAR^VALM1,CLEAN^VALM10
Q
;
RCADD ; -- Add a new Revenue Code
N X,Y,DIE,DR,DIR,DIRUT,DUOUT,DTOUT,ERRMSG,FDA,RETIEN
;
S VALMBCK="R"
D FULL^VALM1
D RCADD1,INIT
Q
;
RCADD1 ; Looping tag for Adding Revenue Codes
K FDA,RETIEN,ERRMSG,X
;
S DIR(0)="350.9399,.01"
S DIR("A")="Revenue Code"
D ^DIR
Q:'X
;
I $D(^IBE(350.9,1,15,"B",+Y)) D G RCADD1
. D FULL^VALM1
. W @IOF
. W !,"This Revenue Code already exists on the Exclusion list."
. W !,"Please enter another Revenue Code."
. Q
;
S FDA(350.9399,"+1,1,",.01)=+Y
D UPDATE^DIE("","FDA","RETIEN","ERRMSG")
G RCADD1
;
RCDEL ; -- Delete a Revenue Code
N DR
D RCDEL1
S VALMBCK="R"
Q
;
RCDEL1 ; Looping tag for deleting Revenue Codes
N Z,VALMY
D FULL^VALM1
D EN^VALM2($G(XQORNOD(0)))
S Z=0
F S Z=$O(VALMY(Z)) Q:'Z D
. N DIK,IEN,RIEN
. S IEN=$O(@VALMAR@("ZIDX",Z,""))
. S RIEN=$O(^IBE(350.9,1,15,"B",IEN,""))
. I +RIEN S DIK="^IBE(350.9,1,15,",DA(1)=1,DA=RIEN D ^DIK
K @VALMAR
D INIT
;D RE^VALM4
Q
;
SET(IBLN,IBSTR) ; -- Add a line to display list
; returns line number added
S IBLN=IBLN+1 D SET^VALM10(IBLN,IBSTR,IBLN)
Q IBLN
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJPS5 2479 printed Apr 09, 2024@21:14:49 Page 2
IBJPS5 ;BP/VAD - IB Site Parameters, Revenue Codes ; 19-AUG-2015
+1 ;;2.0;INTEGRATED BILLING;**547**;21-MAR-94;Build 119
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; -- main entry point for IBJP IB REVENUE CODES
+1 DO EN^VALM("IBJP IB REVENUE CODES")
+2 QUIT
+3 ;
HDR ; -- header code
+1 SET VALMSG=""
+2 QUIT
+3 ;
INIT ; INIT-- init variables and list array
+1 NEW ERROR,IBCNT,IBLN,IBSTR,REVDATA,RIENS,RVCD,RVDSC
+2 ;
+3 SET (VALMCNT,IBCNT,IBLN)=0
+4 IF $DATA(^IBE(350.9,1,15,"B"))
Begin DoDot:1
+5 SET RVCD=0
FOR
SET RVCD=$ORDER(^IBE(350.9,1,15,"B",RVCD))
if 'RVCD
QUIT
Begin DoDot:2
+6 ;
+7 SET RIENS=RVCD_","
+8 DO GETS^DIQ(399.2,RIENS,".01;1;2","I","REVDATA","ERROR")
+9 ; do not included *RESERVED codes (must be ACTIVATE = 1 for Activated)
+10 if $GET(REVDATA(399.2,RIENS,2,"I"))'=1
QUIT
+11 SET IBCNT=IBCNT+1
+12 SET IBSTR=$$SETSTR^VALM1($JUSTIFY(IBCNT,4)_".","",2,6)
+13 SET IBSTR=$$SETSTR^VALM1($JUSTIFY($GET(REVDATA(399.2,RIENS,.01,"I")),3),IBSTR,10,4)
+14 SET IBSTR=$$SETSTR^VALM1($GET(REVDATA(399.2,RIENS,1,"I")),IBSTR,17,30)
+15 SET IBLN=$$SET(IBLN,IBSTR)
+16 SET @VALMAR@("ZIDX",IBCNT,$GET(REVDATA(399.2,RIENS,.01,"I")))=""
+17 QUIT
End DoDot:2
End DoDot:1
+18 ;
+19 IF 'IBLN
SET IBLN=$$SET(IBLN,$$SETSTR^VALM1("No Revenue Codes defined.","",13,40))
+20 ;
+21 SET VALMCNT=IBLN
SET VALMBG=1
+22 QUIT
+23 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 DO CLEAR^VALM1
DO CLEAN^VALM10
+2 QUIT
+3 ;
RCADD ; -- Add a new Revenue Code
+1 NEW X,Y,DIE,DR,DIR,DIRUT,DUOUT,DTOUT,ERRMSG,FDA,RETIEN
+2 ;
+3 SET VALMBCK="R"
+4 DO FULL^VALM1
+5 DO RCADD1
DO INIT
+6 QUIT
+7 ;
RCADD1 ; Looping tag for Adding Revenue Codes
+1 KILL FDA,RETIEN,ERRMSG,X
+2 ;
+3 SET DIR(0)="350.9399,.01"
+4 SET DIR("A")="Revenue Code"
+5 DO ^DIR
+6 if 'X
QUIT
+7 ;
+8 IF $DATA(^IBE(350.9,1,15,"B",+Y))
Begin DoDot:1
+9 DO FULL^VALM1
+10 WRITE @IOF
+11 WRITE !,"This Revenue Code already exists on the Exclusion list."
+12 WRITE !,"Please enter another Revenue Code."
+13 QUIT
End DoDot:1
GOTO RCADD1
+14 ;
+15 SET FDA(350.9399,"+1,1,",.01)=+Y
+16 DO UPDATE^DIE("","FDA","RETIEN","ERRMSG")
+17 GOTO RCADD1
+18 ;
RCDEL ; -- Delete a Revenue Code
+1 NEW DR
+2 DO RCDEL1
+3 SET VALMBCK="R"
+4 QUIT
+5 ;
RCDEL1 ; Looping tag for deleting Revenue Codes
+1 NEW Z,VALMY
+2 DO FULL^VALM1
+3 DO EN^VALM2($GET(XQORNOD(0)))
+4 SET Z=0
+5 FOR
SET Z=$ORDER(VALMY(Z))
if 'Z
QUIT
Begin DoDot:1
+6 NEW DIK,IEN,RIEN
+7 SET IEN=$ORDER(@VALMAR@("ZIDX",Z,""))
+8 SET RIEN=$ORDER(^IBE(350.9,1,15,"B",IEN,""))
+9 IF +RIEN
SET DIK="^IBE(350.9,1,15,"
SET DA(1)=1
SET DA=RIEN
DO ^DIK
End DoDot:1
+10 KILL @VALMAR
+11 DO INIT
+12 ;D RE^VALM4
+13 QUIT
+14 ;
SET(IBLN,IBSTR) ; -- Add a line to display list
+1 ; returns line number added
+2 SET IBLN=IBLN+1
DO SET^VALM10(IBLN,IBSTR,IBLN)
+3 QUIT IBLN
+4 ;
