IBJPC3 ;ALB/YMG - IBJP HCSR Wards/Clinics association with Payer ;10-JUN-2015
;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
;;Per VA Directive 6402, this routine should not be modified.
;;
;
Q
;
ADDPYR(WHICH) ; Add payer association
; WHICH = 1 - use Clinic Search inclusion list
; 2 - use Ward Search inclusion list
;
N ANOTHER,DA,DIC,DLAYGO,DO,DTOUT,DUOUT,IEN,NODE,REFRESH,X,Y
S VALMBCK="R"
D FULL^VALM1
S IEN=$$SELEVENT^IBTRH1(0,"","",0,"IBJPC1IX") I '+IEN Q
S NODE=$S(WHICH=1:63,1:64)
S REFRESH=$$ADDPYR1(NODE,IEN)
I REFRESH D INIT^IBJPC1(WHICH)
Q
;
ADDPYR1(NODE,IEN) ; Add payer association to a given clinic / ward
; NODE = 63 - for Clinic Search inclusion list
; 64 - for Ward Search inclusion list
;
; IEN - IEN in sub-file 350.963 for clinics or 350.964 for wards
;
; returns 1 if screen refresh is necessary, 0 otherwise
;
N ANOTHER,DA,DIC,DLAYGO,DO,DTOUT,DUOUT,REFRESH,X,Y
I NODE'>0!(IEN'>0) Q
D DISPPYR(NODE,IEN)
S REFRESH=0 S:$$ASKALL(NODE,IEN,"YES") REFRESH=1
;
I '$$ISALL(NODE,IEN) D:REFRESH DISPPYR(NODE,IEN) S ANOTHER=1 F D Q:$G(DTOUT)!($G(DUOUT)) Q:'ANOTHER
.S DIC=365.12,DIC(0)="AOEMQ",DIC("A")="Select Payer: "
.S DIC("S")="I '$O(^IBE(350.9,1,"_NODE_","_IEN_",1,""B"",Y,""""))"
.D ^DIC I +Y'>0 S ANOTHER=0 Q
.S DIC="^IBE(350.9,1,"_NODE_","_IEN_",1,"
.S DIC(0)="L",DA(1)=IEN,DA(2)=1,X=+Y,DLAYGO=$S(WHICH=1:350.9631,1:350.9641)
.K DO D FILE^DICN
.I '$G(DTOUT)&('$G(DUOUT)) S:+Y>0 REFRESH=1 W !,$S(+Y>0:"Payer added to the list.",1:"Unable to add payer.")
.Q
Q REFRESH
;
DELPYR(WHICH) ; Delete payer association
; WHICH = 1 - use Clinic Search inclusion list
; 2 - use Ward Search inclusion list
;
N ANOTHER,DA,DIC,DIK,DTOUT,DUOUT,IEN,NODE,REFRESH,X,Y
N IEN,NODE
S VALMBCK="R",REFRESH=0
D FULL^VALM1
S IEN=$$SELEVENT^IBTRH1(0,"","",0,"IBJPC1IX") I '+IEN Q
S NODE=$S(WHICH=1:63,1:64)
D DISPPYR(NODE,IEN)
S:$$ASKALL(NODE,IEN,"NO") REFRESH=1
;
I '$$ISALL(NODE,IEN),$$GETTOT(NODE,IEN)>0 D
.S ANOTHER=1 D:REFRESH DISPPYR(NODE,IEN) F D Q:$G(DTOUT)!($G(DUOUT))!($$GETTOT(NODE,IEN)'>0) Q:'ANOTHER
..S (DIC,DIK)="^IBE(350.9,1,"_NODE_","_IEN_",1,",DIC(0)="AOEMQ",DIC("A")="Select Payer: " D ^DIC
..I +Y'>0 S ANOTHER=0 Q
..S DA(1)=IEN,DA(2)=1,DA=+Y D ^DIK W !,"Payer deleted from the list." S REFRESH=1
..Q
.Q
I REFRESH D INIT^IBJPC1(WHICH)
Q
;
DISPPYR(NODE,IEN) ; Display payer association
; NODE = 63 - for Clinic Search inclusion list
; 64 - for Ward Search inclusion list
;
; IEN - IEN in sub-file 350.963 for clinics or 350.964 for wards
;
N ISALL,PYRNAME,PYRPTR,TOTAL,Z
I '+$G(IEN)!('+$G(NODE)) Q
S ISALL=$$ISALL(NODE,IEN),TOTAL=$$GETTOT(NODE,IEN)
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:"),!
I 'ISALL S Z=0 F S Z=$O(^IBE(350.9,1,NODE,IEN,1,Z)) Q:'Z D
.S PYRPTR=+$P(^IBE(350.9,1,NODE,IEN,1,Z,0),U) I PYRPTR W !,$P(^IBE(365.12,PYRPTR,0),U)
.Q
W !
Q
;
ASKALL(NODE,IEN,DEF) ; Prompt for association with all payers
; NODE = 63 - for Clinic Search inclusion list
; 64 - for Ward Search inclusion list
;
; IEN - IEN in sub-file 350.963 for clinics or 350.964 for wards
; DEF - default for the prompt ("YES" or "NO")
;
; returns 1 if value of .02 field has changed, 0 otherwise
;
N DA,DIE,DR,DTOUT,VAL,X,Y
S VAL=$$ISALL(NODE,IEN)
S DIE="^IBE(350.9,1,"_NODE_",",DA=IEN,DR=".02//"_DEF D ^DIE
Q $S(VAL=$$ISALL(NODE,IEN):0,1:1)
;
ISALL(NODE,IEN) ; Check association with all payers
; NODE = 63 - for Clinic Search inclusion list
; 64 - for Ward Search inclusion list
;
; IEN - IEN in sub-file 350.963 for clinics or 350.964 for wards
;
; Returns 1 if clinic/ward is associated with all payers, 0 otherwise
N RES
S RES=0 I +$G(IEN)&(+$G(NODE)) S RES=+$P($G(^IBE(350.9,1,NODE,IEN,0)),U,2)
Q RES
;
GETTOT(NODE,IEN) ; Returns total number of payers associated with clinic/ward.
; NODE = 63 - for Clinic Search inclusion list
; 64 - for Ward Search inclusion list
;
; IEN - IEN in sub-file 350.963 for clinics or 350.964 for wards
;
N RES
S RES=0 I +$G(IEN)&(+$G(NODE)) S RES=+$P($G(^IBE(350.9,1,NODE,IEN,1,0)),U,4)
Q RES
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJPC3 4334 printed Apr 09, 2024@21:37:18 Page 2
IBJPC3 ;ALB/YMG - IBJP HCSR Wards/Clinics association with Payer ;10-JUN-2015
+1 ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;
+4 ;
+5 QUIT
+6 ;
ADDPYR(WHICH) ; Add payer association
+1 ; WHICH = 1 - use Clinic Search inclusion list
+2 ; 2 - use Ward Search inclusion list
+3 ;
+4 NEW ANOTHER,DA,DIC,DLAYGO,DO,DTOUT,DUOUT,IEN,NODE,REFRESH,X,Y
+5 SET VALMBCK="R"
+6 DO FULL^VALM1
+7 SET IEN=$$SELEVENT^IBTRH1(0,"","",0,"IBJPC1IX")
IF '+IEN
QUIT
+8 SET NODE=$SELECT(WHICH=1:63,1:64)
+9 SET REFRESH=$$ADDPYR1(NODE,IEN)
+10 IF REFRESH
DO INIT^IBJPC1(WHICH)
+11 QUIT
+12 ;
ADDPYR1(NODE,IEN) ; Add payer association to a given clinic / ward
+1 ; NODE = 63 - for Clinic Search inclusion list
+2 ; 64 - for Ward Search inclusion list
+3 ;
+4 ; IEN - IEN in sub-file 350.963 for clinics or 350.964 for wards
+5 ;
+6 ; returns 1 if screen refresh is necessary, 0 otherwise
+7 ;
+8 NEW ANOTHER,DA,DIC,DLAYGO,DO,DTOUT,DUOUT,REFRESH,X,Y
+9 IF NODE'>0!(IEN'>0)
QUIT
+10 DO DISPPYR(NODE,IEN)
+11 SET REFRESH=0
if $$ASKALL(NODE,IEN,"YES")
SET REFRESH=1
+12 ;
+13 IF '$$ISALL(NODE,IEN)
if REFRESH
DO DISPPYR(NODE,IEN)
SET ANOTHER=1
FOR
Begin DoDot:1
+14 SET DIC=365.12
SET DIC(0)="AOEMQ"
SET DIC("A")="Select Payer: "
+15 SET DIC("S")="I '$O(^IBE(350.9,1,"_NODE_","_IEN_",1,""B"",Y,""""))"
+16 DO ^DIC
IF +Y'>0
SET ANOTHER=0
QUIT
+17 SET DIC="^IBE(350.9,1,"_NODE_","_IEN_",1,"
+18 SET DIC(0)="L"
SET DA(1)=IEN
SET DA(2)=1
SET X=+Y
SET DLAYGO=$SELECT(WHICH=1:350.9631,1:350.9641)
+19 KILL DO
DO FILE^DICN
+20 IF '$GET(DTOUT)&('$GET(DUOUT))
if +Y>0
SET REFRESH=1
WRITE !,$SELECT(+Y>0:"Payer added to the list.",1:"Unable to add payer.")
+21 QUIT
End DoDot:1
if $GET(DTOUT)!($GET(DUOUT))
QUIT
if 'ANOTHER
QUIT
+22 QUIT REFRESH
+23 ;
DELPYR(WHICH) ; Delete payer association
+1 ; WHICH = 1 - use Clinic Search inclusion list
+2 ; 2 - use Ward Search inclusion list
+3 ;
+4 NEW ANOTHER,DA,DIC,DIK,DTOUT,DUOUT,IEN,NODE,REFRESH,X,Y
+5 NEW IEN,NODE
+6 SET VALMBCK="R"
SET REFRESH=0
+7 DO FULL^VALM1
+8 SET IEN=$$SELEVENT^IBTRH1(0,"","",0,"IBJPC1IX")
IF '+IEN
QUIT
+9 SET NODE=$SELECT(WHICH=1:63,1:64)
+10 DO DISPPYR(NODE,IEN)
+11 if $$ASKALL(NODE,IEN,"NO")
SET REFRESH=1
+12 ;
+13 IF '$$ISALL(NODE,IEN)
IF $$GETTOT(NODE,IEN)>0
Begin DoDot:1
+14 SET ANOTHER=1
if REFRESH
DO DISPPYR(NODE,IEN)
FOR
Begin DoDot:2
+15 SET (DIC,DIK)="^IBE(350.9,1,"_NODE_","_IEN_",1,"
SET DIC(0)="AOEMQ"
SET DIC("A")="Select Payer: "
DO ^DIC
+16 IF +Y'>0
SET ANOTHER=0
QUIT
+17 SET DA(1)=IEN
SET DA(2)=1
SET DA=+Y
DO ^DIK
WRITE !,"Payer deleted from the list."
SET REFRESH=1
+18 QUIT
End DoDot:2
if $GET(DTOUT)!($GET(DUOUT))!($$GETTOT(NODE,IEN)'>0)
QUIT
if 'ANOTHER
QUIT
+19 QUIT
End DoDot:1
+20 IF REFRESH
DO INIT^IBJPC1(WHICH)
+21 QUIT
+22 ;
DISPPYR(NODE,IEN) ; Display payer association
+1 ; NODE = 63 - for Clinic Search inclusion list
+2 ; 64 - for Ward Search inclusion list
+3 ;
+4 ; IEN - IEN in sub-file 350.963 for clinics or 350.964 for wards
+5 ;
+6 NEW ISALL,PYRNAME,PYRPTR,TOTAL,Z
+7 IF '+$GET(IEN)!('+$GET(NODE))
QUIT
+8 SET ISALL=$$ISALL(NODE,IEN)
SET TOTAL=$$GETTOT(NODE,IEN)
+9 WRITE !!,$SELECT(WHICH=1:"Clinic",1:"Ward")," is currently included in the list for ",$SELECT(ISALL:"all payers.",'ISALL&('TOTAL):"no payers",1:"the following "_TOTAL_" payers:"),!
+10 IF 'ISALL
SET Z=0
FOR
SET Z=$ORDER(^IBE(350.9,1,NODE,IEN,1,Z))
if 'Z
QUIT
Begin DoDot:1
+11 SET PYRPTR=+$PIECE(^IBE(350.9,1,NODE,IEN,1,Z,0),U)
IF PYRPTR
WRITE !,$PIECE(^IBE(365.12,PYRPTR,0),U)
+12 QUIT
End DoDot:1
+13 WRITE !
+14 QUIT
+15 ;
ASKALL(NODE,IEN,DEF) ; Prompt for association with all payers
+1 ; NODE = 63 - for Clinic Search inclusion list
+2 ; 64 - for Ward Search inclusion list
+3 ;
+4 ; IEN - IEN in sub-file 350.963 for clinics or 350.964 for wards
+5 ; DEF - default for the prompt ("YES" or "NO")
+6 ;
+7 ; returns 1 if value of .02 field has changed, 0 otherwise
+8 ;
+9 NEW DA,DIE,DR,DTOUT,VAL,X,Y
+10 SET VAL=$$ISALL(NODE,IEN)
+11 SET DIE="^IBE(350.9,1,"_NODE_","
SET DA=IEN
SET DR=".02//"_DEF
DO ^DIE
+12 QUIT $SELECT(VAL=$$ISALL(NODE,IEN):0,1:1)
+13 ;
ISALL(NODE,IEN) ; Check association with all payers
+1 ; NODE = 63 - for Clinic Search inclusion list
+2 ; 64 - for Ward Search inclusion list
+3 ;
+4 ; IEN - IEN in sub-file 350.963 for clinics or 350.964 for wards
+5 ;
+6 ; Returns 1 if clinic/ward is associated with all payers, 0 otherwise
+7 NEW RES
+8 SET RES=0
IF +$GET(IEN)&(+$GET(NODE))
SET RES=+$PIECE($GET(^IBE(350.9,1,NODE,IEN,0)),U,2)
+9 QUIT RES
+10 ;
GETTOT(NODE,IEN) ; Returns total number of payers associated with clinic/ward.
+1 ; NODE = 63 - for Clinic Search inclusion list
+2 ; 64 - for Ward Search inclusion list
+3 ;
+4 ; IEN - IEN in sub-file 350.963 for clinics or 350.964 for wards
+5 ;
+6 NEW RES
+7 SET RES=0
IF +$GET(IEN)&(+$GET(NODE))
SET RES=+$PIECE($GET(^IBE(350.9,1,NODE,IEN,1,0)),U,4)
+8 QUIT RES
