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

IBJPS7.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. EN(IBTCFLAG) ; -- main entry point for IBJP IB PAY-TO RATE TYPES
  1. ; select pay-to provider
  1. Q:(IBTCFLAG'=1) ; Only want Non-MCCF Pay-To Provider Rate Types
  1. D EN^VALM("IBJP IB NON-MCCF RATE TYPES")
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. HDR ; -- header code
  1. S VALMSG=""
  1. Q
  1. ;
  1. INIT(IBTCFLAG) ; -- init variables and list array
  1. N ERROR,IBCNT,IBLN,IBSTR,RTYDATA,RIENS,RTYPE
  1. Q:(IBTCFLAG'=1) ; Only want Non-MCCF Pay-To Provider Rate Types
  1. ;
  1. S (VALMCNT,IBCNT,IBLN)=0
  1. I $D(^IBE(350.9,1,28,"B")) D
  1. . S RTYPE=0 F S RTYPE=$O(^IBE(350.9,1,28,"B",RTYPE)) Q:'RTYPE D
  1. . . ;
  1. . . S RIENS=RTYPE_","
  1. . . D GETS^DIQ(399.3,RIENS,".001;.01;.03","I","RTYDATA","ERROR")
  1. . . ; do not included *RESERVED codes (must be ACTIVATE = 0 for Active, 1 = InActive)
  1. . . Q:+$G(RTYDATA(399.3,RIENS,.03,"I"))
  1. . . S IBCNT=IBCNT+1
  1. . . S IBSTR=$$SETSTR^VALM1($J(IBCNT,4)_".","",2,6)
  1. . . S IBSTR=$$SETSTR^VALM1($J($G(RTYDATA(399.3,RIENS,.001,"I")),3),IBSTR,10,4)
  1. . . S IBSTR=$$SETSTR^VALM1($G(RTYDATA(399.3,RIENS,.01,"I")),IBSTR,17,30)
  1. . . S IBLN=$$SET(IBLN,IBSTR)
  1. . . S @VALMAR@("ZIDX",IBCNT,$G(RTYDATA(399.3,RIENS,.001,"I")))=""
  1. . . Q
  1. ;
  1. I 'IBLN S IBLN=$$SET(IBLN,$$SETSTR^VALM1("No Rate Types defined.","",13,40))
  1. ;
  1. S VALMCNT=IBLN,VALMBG=1
  1. Q
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. D CLEAR^VALM1,CLEAN^VALM10
  1. Q
  1. ;
  1. RTADD(IBTCFLAG) ; -- Add a new Rate Type
  1. N DA,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FDA,IEN,IENS,X,Y,Z
  1. ;
  1. S VALMBCK="R"
  1. Q:'$$LOCK() ; Couldn't lock for adding
  1. D FULL^VALM1
  1. ;
  1. I '$$ENTSEL(.IENS) D Q ; Select entry(s) to be added
  1. . S VALMSG="No Rate Type selected"
  1. . D UNLOCK
  1. D UNLOCK ; Unlock the node.
  1. D INIT(IBTCFLAG) ; Rebuild list body
  1. S VALMSG="Added Rate Type(s)"
  1. Q
  1. ;
  1. RTDEL(IBTCFLAG) ; -- Delete a Rate Type
  1. N VALMY,Z
  1. D FULL^VALM1
  1. D EN^VALM2($G(XQORNOD(0)))
  1. S Z=0
  1. F S Z=$O(VALMY(Z)) Q:'Z D
  1. . N DA,DIK,IEN,RIEN
  1. . S IEN=$O(@VALMAR@("ZIDX",Z,""))
  1. . Q:'IEN
  1. . S RIEN=$O(^IBE(350.9,1,28,"B",IEN,""))
  1. . I +RIEN S DIK="^IBE(350.9,1,28,",DA(1)=1,DA=RIEN D ^DIK
  1. K @VALMAR
  1. D INIT(IBTCFLAG)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. SET(IBLN,IBSTR) ; -- Add a line to display list
  1. ; returns line number added
  1. S IBLN=IBLN+1 D SET^VALM10(IBLN,IBSTR,IBLN)
  1. Q IBLN
  1. ;
  1. 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
  1. ; Returns: 1 - At least one IEN selected, 0 otherwise
  1. N DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FDA,STOP,X,Y,Z
  1. K IENS
  1. S STOP=0
  1. S DIC=399.3
  1. S DIC(0)="AEQM"
  1. S DIC("A")="Select a Rate Type to be added: "
  1. ;
  1. ; Set the Add filter
  1. S DIC("S")="I '$D(^IBE(350.9,1,28,""B"",Y))&'$D(IENS(+Y))"
  1. F D Q:STOP
  1. . D ^DIC
  1. . I Y'>0 S STOP=1 Q
  1. . S IENS(+Y)=""
  1. . ; create entry for Rate Type
  1. . K FDA
  1. . S FDA("350.928","+1,1,",.01)=+Y
  1. . S FDA("350.928","+1,1,",.02)=0
  1. . D UPDATE^DIE("","FDA")
  1. . Q
  1. ;
  1. I '$D(IENS) Q 0 ; No IENS selected
  1. Q 1
  1. ;
  1. LOCK() ;EP
  1. ; Attempt to lock the Non-MCCF Pay-To Providers Rate Types for Site Parameters.
  1. ; Returns: 1 - Successfully locked
  1. ; 0 - Not successfully locked and an error message is
  1. ; displayed
  1. L +^IBE(350.9,1,28):1
  1. I '$T D Q 0
  1. . W @IOF,"Someone else is editing the Non-MCCF Pay-To Providers Rate Types"
  1. . W !,"Please Try again later"
  1. . D PAUSE^VALM1
  1. Q 1
  1. ;
  1. UNLOCK ;EP
  1. ; Unlocks the Non-MCCF Pay-To Providers Rate Types for IB Site Parameters.
  1. L -^IBE(350.9,1,28)
  1. Q
  1. ;