IBJPS7 ;ALB/VD - IB Site Parameters, Pay-To Provider Rate Types ;02-Feb-2018
;;2.0;INTEGRATED BILLING;**608**;21-MAR-94;Build 90
;;Per VA Directive 6402, this routine should not be modified.
;
EN(IBTCFLAG) ; -- main entry point for IBJP IB PAY-TO RATE TYPES
; select pay-to provider
Q:(IBTCFLAG'=1) ; Only want Non-MCCF Pay-To Provider Rate Types
D EN^VALM("IBJP IB NON-MCCF RATE TYPES")
S VALMBCK="R"
Q
;
HDR ; -- header code
S VALMSG=""
Q
;
INIT(IBTCFLAG) ; -- init variables and list array
N ERROR,IBCNT,IBLN,IBSTR,RTYDATA,RIENS,RTYPE
Q:(IBTCFLAG'=1) ; Only want Non-MCCF Pay-To Provider Rate Types
;
S (VALMCNT,IBCNT,IBLN)=0
I $D(^IBE(350.9,1,28,"B")) D
. S RTYPE=0 F S RTYPE=$O(^IBE(350.9,1,28,"B",RTYPE)) Q:'RTYPE D
. . ;
. . S RIENS=RTYPE_","
. . D GETS^DIQ(399.3,RIENS,".001;.01;.03","I","RTYDATA","ERROR")
. . ; do not included *RESERVED codes (must be ACTIVATE = 0 for Active, 1 = InActive)
. . Q:+$G(RTYDATA(399.3,RIENS,.03,"I"))
. . S IBCNT=IBCNT+1
. . S IBSTR=$$SETSTR^VALM1($J(IBCNT,4)_".","",2,6)
. . S IBSTR=$$SETSTR^VALM1($J($G(RTYDATA(399.3,RIENS,.001,"I")),3),IBSTR,10,4)
. . S IBSTR=$$SETSTR^VALM1($G(RTYDATA(399.3,RIENS,.01,"I")),IBSTR,17,30)
. . S IBLN=$$SET(IBLN,IBSTR)
. . S @VALMAR@("ZIDX",IBCNT,$G(RTYDATA(399.3,RIENS,.001,"I")))=""
. . Q
;
I 'IBLN S IBLN=$$SET(IBLN,$$SETSTR^VALM1("No Rate Types 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
;
RTADD(IBTCFLAG) ; -- Add a new Rate Type
N DA,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FDA,IEN,IENS,X,Y,Z
;
S VALMBCK="R"
Q:'$$LOCK() ; Couldn't lock for adding
D FULL^VALM1
;
I '$$ENTSEL(.IENS) D Q ; Select entry(s) to be added
. S VALMSG="No Rate Type selected"
. D UNLOCK
D UNLOCK ; Unlock the node.
D INIT(IBTCFLAG) ; Rebuild list body
S VALMSG="Added Rate Type(s)"
Q
;
RTDEL(IBTCFLAG) ; -- Delete a Rate Type
N VALMY,Z
D FULL^VALM1
D EN^VALM2($G(XQORNOD(0)))
S Z=0
F S Z=$O(VALMY(Z)) Q:'Z D
. N DA,DIK,IEN,RIEN
. S IEN=$O(@VALMAR@("ZIDX",Z,""))
. Q:'IEN
. S RIEN=$O(^IBE(350.9,1,28,"B",IEN,""))
. I +RIEN S DIK="^IBE(350.9,1,28,",DA(1)=1,DA=RIEN D ^DIK
K @VALMAR
D INIT(IBTCFLAG)
S VALMBCK="R"
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
;
ENTSEL(IENS) ; Selects an entry to be added to the specified Site Parameter Node
; Output: IENS - Array of selected IEN(s), "" if not selected
; Returns: 1 - At least one IEN selected, 0 otherwise
N DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FDA,STOP,X,Y,Z
K IENS
S STOP=0
S DIC=399.3
S DIC(0)="AEQM"
S DIC("A")="Select a Rate Type to be added: "
;
; Set the Add filter
S DIC("S")="I '$D(^IBE(350.9,1,28,""B"",Y))&'$D(IENS(+Y))"
F D Q:STOP
. D ^DIC
. I Y'>0 S STOP=1 Q
. S IENS(+Y)=""
. ; create entry for Rate Type
. K FDA
. S FDA("350.928","+1,1,",.01)=+Y
. S FDA("350.928","+1,1,",.02)=0
. D UPDATE^DIE("","FDA")
. Q
;
I '$D(IENS) Q 0 ; No IENS selected
Q 1
;
LOCK() ;EP
; Attempt to lock the Non-MCCF Pay-To Providers Rate Types for Site Parameters.
; Returns: 1 - Successfully locked
; 0 - Not successfully locked and an error message is
; displayed
L +^IBE(350.9,1,28):1
I '$T D Q 0
. W @IOF,"Someone else is editing the Non-MCCF Pay-To Providers Rate Types"
. W !,"Please Try again later"
. D PAUSE^VALM1
Q 1
;
UNLOCK ;EP
; Unlocks the Non-MCCF Pay-To Providers Rate Types for IB Site Parameters.
L -^IBE(350.9,1,28)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJPS7 3684 printed Apr 09, 2024@21:36:59 Page 2
IBJPS7 ;ALB/VD - IB Site Parameters, Pay-To Provider Rate Types ;02-Feb-2018
+1 ;;2.0;INTEGRATED BILLING;**608**;21-MAR-94;Build 90
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN(IBTCFLAG) ; -- main entry point for IBJP IB PAY-TO RATE TYPES
+1 ; select pay-to provider
+2 ; Only want Non-MCCF Pay-To Provider Rate Types
if (IBTCFLAG'=1)
QUIT
+3 DO EN^VALM("IBJP IB NON-MCCF RATE TYPES")
+4 SET VALMBCK="R"
+5 QUIT
+6 ;
HDR ; -- header code
+1 SET VALMSG=""
+2 QUIT
+3 ;
INIT(IBTCFLAG) ; -- init variables and list array
+1 NEW ERROR,IBCNT,IBLN,IBSTR,RTYDATA,RIENS,RTYPE
+2 ; Only want Non-MCCF Pay-To Provider Rate Types
if (IBTCFLAG'=1)
QUIT
+3 ;
+4 SET (VALMCNT,IBCNT,IBLN)=0
+5 IF $DATA(^IBE(350.9,1,28,"B"))
Begin DoDot:1
+6 SET RTYPE=0
FOR
SET RTYPE=$ORDER(^IBE(350.9,1,28,"B",RTYPE))
if 'RTYPE
QUIT
Begin DoDot:2
+7 ;
+8 SET RIENS=RTYPE_","
+9 DO GETS^DIQ(399.3,RIENS,".001;.01;.03","I","RTYDATA","ERROR")
+10 ; do not included *RESERVED codes (must be ACTIVATE = 0 for Active, 1 = InActive)
+11 if +$GET(RTYDATA(399.3,RIENS,.03,"I"))
QUIT
+12 SET IBCNT=IBCNT+1
+13 SET IBSTR=$$SETSTR^VALM1($JUSTIFY(IBCNT,4)_".","",2,6)
+14 SET IBSTR=$$SETSTR^VALM1($JUSTIFY($GET(RTYDATA(399.3,RIENS,.001,"I")),3),IBSTR,10,4)
+15 SET IBSTR=$$SETSTR^VALM1($GET(RTYDATA(399.3,RIENS,.01,"I")),IBSTR,17,30)
+16 SET IBLN=$$SET(IBLN,IBSTR)
+17 SET @VALMAR@("ZIDX",IBCNT,$GET(RTYDATA(399.3,RIENS,.001,"I")))=""
+18 QUIT
End DoDot:2
End DoDot:1
+19 ;
+20 IF 'IBLN
SET IBLN=$$SET(IBLN,$$SETSTR^VALM1("No Rate Types defined.","",13,40))
+21 ;
+22 SET VALMCNT=IBLN
SET VALMBG=1
+23 QUIT
+24 ;
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 ;
RTADD(IBTCFLAG) ; -- Add a new Rate Type
+1 NEW DA,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FDA,IEN,IENS,X,Y,Z
+2 ;
+3 SET VALMBCK="R"
+4 ; Couldn't lock for adding
if '$$LOCK()
QUIT
+5 DO FULL^VALM1
+6 ;
+7 ; Select entry(s) to be added
IF '$$ENTSEL(.IENS)
Begin DoDot:1
+8 SET VALMSG="No Rate Type selected"
+9 DO UNLOCK
End DoDot:1
QUIT
+10 ; Unlock the node.
DO UNLOCK
+11 ; Rebuild list body
DO INIT(IBTCFLAG)
+12 SET VALMSG="Added Rate Type(s)"
+13 QUIT
+14 ;
RTDEL(IBTCFLAG) ; -- Delete a Rate Type
+1 NEW VALMY,Z
+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 DA,DIK,IEN,RIEN
+7 SET IEN=$ORDER(@VALMAR@("ZIDX",Z,""))
+8 if 'IEN
QUIT
+9 SET RIEN=$ORDER(^IBE(350.9,1,28,"B",IEN,""))
+10 IF +RIEN
SET DIK="^IBE(350.9,1,28,"
SET DA(1)=1
SET DA=RIEN
DO ^DIK
End DoDot:1
+11 KILL @VALMAR
+12 DO INIT(IBTCFLAG)
+13 SET VALMBCK="R"
+14 QUIT
+15 ;
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 ;
ENTSEL(IENS) ; Selects an entry to be added to the specified Site Parameter Node
+1 ; Output: IENS - Array of selected IEN(s), "" if not selected
+2 ; Returns: 1 - At least one IEN selected, 0 otherwise
+3 NEW DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FDA,STOP,X,Y,Z
+4 KILL IENS
+5 SET STOP=0
+6 SET DIC=399.3
+7 SET DIC(0)="AEQM"
+8 SET DIC("A")="Select a Rate Type to be added: "
+9 ;
+10 ; Set the Add filter
+11 SET DIC("S")="I '$D(^IBE(350.9,1,28,""B"",Y))&'$D(IENS(+Y))"
+12 FOR
Begin DoDot:1
+13 DO ^DIC
+14 IF Y'>0
SET STOP=1
QUIT
+15 SET IENS(+Y)=""
+16 ; create entry for Rate Type
+17 KILL FDA
+18 SET FDA("350.928","+1,1,",.01)=+Y
+19 SET FDA("350.928","+1,1,",.02)=0
+20 DO UPDATE^DIE("","FDA")
+21 QUIT
End DoDot:1
if STOP
QUIT
+22 ;
+23 ; No IENS selected
IF '$DATA(IENS)
QUIT 0
+24 QUIT 1
+25 ;
LOCK() ;EP
+1 ; Attempt to lock the Non-MCCF Pay-To Providers Rate Types for Site Parameters.
+2 ; Returns: 1 - Successfully locked
+3 ; 0 - Not successfully locked and an error message is
+4 ; displayed
+5 LOCK +^IBE(350.9,1,28):1
+6 IF '$TEST
Begin DoDot:1
+7 WRITE @IOF,"Someone else is editing the Non-MCCF Pay-To Providers Rate Types"
+8 WRITE !,"Please Try again later"
+9 DO PAUSE^VALM1
End DoDot:1
QUIT 0
+10 QUIT 1
+11 ;
UNLOCK ;EP
+1 ; Unlocks the Non-MCCF Pay-To Providers Rate Types for IB Site Parameters.
+2 LOCK -^IBE(350.9,1,28)
+3 QUIT
+4 ;
