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

IBJPC3.m

Go to the documentation of this file. 
  1. IBJPC3 ;ALB/YMG - IBJP HCSR Wards/Clinics association with Payer ;10-JUN-2015
  1.  ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;;
  1.  ;
  1.  Q
  1.  ;
  1. ADDPYR(WHICH) ; Add payer association
  1.  ; WHICH = 1 - use Clinic Search inclusion list
  1.  ;         2 - use Ward Search inclusion list
  1.  ;
  1.  N ANOTHER,DA,DIC,DLAYGO,DO,DTOUT,DUOUT,IEN,NODE,REFRESH,X,Y
  1.  S VALMBCK="R"
  1.  D FULL^VALM1
  1.  S IEN=$$SELEVENT^IBTRH1(0,"","",0,"IBJPC1IX") I '+IEN Q
  1.  S NODE=$S(WHICH=1:63,1:64)
  1.  S REFRESH=$$ADDPYR1(NODE,IEN)
  1.  I REFRESH D INIT^IBJPC1(WHICH)
  1.  Q
  1.  ;
  1. ADDPYR1(NODE,IEN) ; Add payer association to a given clinic / ward
  1.  ; NODE = 63 - for Clinic Search inclusion list
  1.  ;        64 - for Ward Search inclusion list
  1.  ;
  1.  ; IEN - IEN in sub-file 350.963 for clinics or 350.964 for wards
  1.  ;
  1.  ; returns 1 if screen refresh is necessary, 0 otherwise
  1.  ;
  1.  N ANOTHER,DA,DIC,DLAYGO,DO,DTOUT,DUOUT,REFRESH,X,Y
  1.  I NODE'>0!(IEN'>0) Q
  1.  D DISPPYR(NODE,IEN)
  1.  S REFRESH=0 S:$$ASKALL(NODE,IEN,"YES") REFRESH=1
  1.  ;
  1.  I '$$ISALL(NODE,IEN) D:REFRESH DISPPYR(NODE,IEN) S ANOTHER=1 F  D  Q:$G(DTOUT)!($G(DUOUT))  Q:'ANOTHER
  1.  .S DIC=365.12,DIC(0)="AOEMQ",DIC("A")="Select Payer: "
  1.  .S DIC("S")="I '$O(^IBE(350.9,1,"_NODE_","_IEN_",1,""B"",Y,""""))"
  1.  .D ^DIC I +Y'>0 S ANOTHER=0 Q
  1.  .S DIC="^IBE(350.9,1,"_NODE_","_IEN_",1,"
  1.  .S DIC(0)="L",DA(1)=IEN,DA(2)=1,X=+Y,DLAYGO=$S(WHICH=1:350.9631,1:350.9641)
  1.  .K DO D FILE^DICN
  1.  .I '$G(DTOUT)&('$G(DUOUT)) S:+Y>0 REFRESH=1 W !,$S(+Y>0:"Payer added to the list.",1:"Unable to add payer.")
  1.  .Q 
  1.  Q REFRESH
  1.  ;
  1. DELPYR(WHICH) ; Delete payer association
  1.  ; WHICH = 1 - use Clinic Search inclusion list
  1.  ;         2 - use Ward Search inclusion list
  1.  ;
  1.  N ANOTHER,DA,DIC,DIK,DTOUT,DUOUT,IEN,NODE,REFRESH,X,Y
  1.  N IEN,NODE
  1.  S VALMBCK="R",REFRESH=0
  1.  D FULL^VALM1
  1.  S IEN=$$SELEVENT^IBTRH1(0,"","",0,"IBJPC1IX") I '+IEN Q
  1.  S NODE=$S(WHICH=1:63,1:64)
  1.  D DISPPYR(NODE,IEN)
  1.  S:$$ASKALL(NODE,IEN,"NO") REFRESH=1
  1.  ;
  1.  I '$$ISALL(NODE,IEN),$$GETTOT(NODE,IEN)>0 D
  1.  .S ANOTHER=1 D:REFRESH DISPPYR(NODE,IEN) F  D  Q:$G(DTOUT)!($G(DUOUT))!($$GETTOT(NODE,IEN)'>0)  Q:'ANOTHER
  1.  ..S (DIC,DIK)="^IBE(350.9,1,"_NODE_","_IEN_",1,",DIC(0)="AOEMQ",DIC("A")="Select Payer: " D ^DIC
  1.  ..I +Y'>0 S ANOTHER=0 Q
  1.  ..S DA(1)=IEN,DA(2)=1,DA=+Y D ^DIK W !,"Payer deleted from the list." S REFRESH=1
  1.  ..Q
  1.  .Q
  1.  I REFRESH D INIT^IBJPC1(WHICH)
  1.  Q
  1.  ;
  1. DISPPYR(NODE,IEN) ; Display payer association
  1.  ; NODE = 63 - for Clinic Search inclusion list
  1.  ;        64 - for Ward Search inclusion list
  1.  ;
  1.  ; IEN - IEN in sub-file 350.963 for clinics or 350.964 for wards
  1.  ;
  1.  N ISALL,PYRNAME,PYRPTR,TOTAL,Z
  1.  I '+$G(IEN)!('+$G(NODE)) Q
  1.  S ISALL=$$ISALL(NODE,IEN),TOTAL=$$GETTOT(NODE,IEN)
  1.  W !!,$S(WHICH=1:"Clinic",1:"Ward")," is currently included in the list for ",$S(ISALL:"all payers.",'ISALL&('TOTAL):"no payers",1:"the following "_TOTAL_" payers:"),!
  1.  I 'ISALL S Z=0 F  S Z=$O(^IBE(350.9,1,NODE,IEN,1,Z)) Q:'Z  D
  1.  .S PYRPTR=+$P(^IBE(350.9,1,NODE,IEN,1,Z,0),U) I PYRPTR W !,$P(^IBE(365.12,PYRPTR,0),U)
  1.  .Q
  1.  W !
  1.  Q
  1.  ;
  1. ASKALL(NODE,IEN,DEF) ; Prompt for association with all payers
  1.  ; NODE = 63 - for Clinic Search inclusion list
  1.  ;        64 - for Ward Search inclusion list
  1.  ;
  1.  ; IEN - IEN in sub-file 350.963 for clinics or 350.964 for wards
  1.  ; DEF - default for the prompt ("YES" or "NO")
  1.  ;
  1.  ; returns 1 if value of .02 field has changed, 0 otherwise
  1.  ;
  1.  N DA,DIE,DR,DTOUT,VAL,X,Y
  1.  S VAL=$$ISALL(NODE,IEN)
  1.  S DIE="^IBE(350.9,1,"_NODE_",",DA=IEN,DR=".02//"_DEF D ^DIE
  1.  Q $S(VAL=$$ISALL(NODE,IEN):0,1:1)
  1.  ;
  1. ISALL(NODE,IEN) ; Check association with all payers
  1.  ; NODE = 63 - for Clinic Search inclusion list
  1.  ;        64 - for Ward Search inclusion list
  1.  ;
  1.  ; IEN - IEN in sub-file 350.963 for clinics or 350.964 for wards
  1.  ;
  1.  ; Returns 1 if clinic/ward is associated with all payers, 0 otherwise
  1.  N RES
  1.  S RES=0 I +$G(IEN)&(+$G(NODE)) S RES=+$P($G(^IBE(350.9,1,NODE,IEN,0)),U,2)
  1.  Q RES
  1.  ;
  1. GETTOT(NODE,IEN) ; Returns total number of payers associated with clinic/ward.
  1.  ; NODE = 63 - for Clinic Search inclusion list
  1.  ;        64 - for Ward Search inclusion list
  1.  ;
  1.  ; IEN - IEN in sub-file 350.963 for clinics or 350.964 for wards
  1.  ;
  1.  N RES
  1.  S RES=0 I +$G(IEN)&(+$G(NODE)) S RES=+$P($G(^IBE(350.9,1,NODE,IEN,1,0)),U,4)
  1.  Q RES