- 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 Feb 18, 2025@23:50:05 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 ;