IBEPAR ;ALB/AAS - MCCR SITE PARAMETER ENTER/EDIT ;26-MAR-92
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
% ;
S IBPAR=1,IBV1="00000",IBSR="PAR",IBSR1="" F I=0,1,2 S IBEPAR(I)=$S($D(^IBE(350.9,1,I)):^(I),1:"")
D ^IBCSCU
S L="",$P(L,"=",80)=""
I $D(IBPAR) S X="MEDICAL CARE COST RECOVERY PARAMETER ENTER/EDIT" W @IOF,?17,IBVI,X,IBVO,!,L
;
1 S Z=1,IBW=1 X IBWW W " Medical Center Name: "_$P($G(^DIC(4,+$P(IBEPAR(0),"^",2),0)),"^"),?47,"Federal Tax #",?66,": ",$S($P(IBEPAR(1),"^",5)]"":$P(IBEPAR(1),"^",5),1:IBU)
W !?4,"Default BC/BS #",?23,": ",$S($P(IBEPAR(1),"^",6)]"":$P(IBEPAR(1),"^",6),1:IBU)
W ?47,"Medicare Number",?66,": ",$S($P(IBEPAR(1),"^",21)]"":$P(IBEPAR(1),"^",21),1:IBU)
W !?4,"MAS Service Pointer",?23,": ",$E($S($P(IBEPAR(1),"^",14)]""&($D(^DIC(49,+$P(IBEPAR(1),"^",14),0))):$P(^(0),"^",1),1:IBU),1,20)
W ?47,"Default Division",?66,": ",$E($S($P(IBEPAR(1),"^",25)]"":$P($G(^DG(40.8,+$P(IBEPAR(1),"^",25),0)),"^"),1:IBU),1,12),!
;
2 S Z=2,IBW=1 X IBWW W " Bill Signer Name : "_$S($P(IBEPAR(1),"^",1)]"":$P(IBEPAR(1),"^",1),1:IBU)
W ?47,"Title: ",$S($P(IBEPAR(1),"^",2)]"":$P(IBEPAR(1),"^",2),1:IBU)
W !?4,"Billing Supervisor",?23,": " S IBSUP=$S($P(IBEPAR(1),"^",8)]"":$P(IBEPAR(1),"^",8),1:IBU) I IBSUP'=IBU S IBSUP=$P(^VA(200,IBSUP,0),"^",1)
W:IBSUP'=IBU $P(IBSUP,",",2)," ",$P(IBSUP,",",1),! W:IBSUP=IBU IBU,!
;
3 S Z=3,IBW=1 X IBWW W " Multiple Form Types: "_$S($P(IBEPAR(1),"^",22)=1:"YES",$P(IBEPAR(1),"^",11)=0:"NO",1:IBU)
W ?47,"Initiator Authorize: ",$S($P(IBEPAR(1),"^",23)=1:"YES",$P(IBEPAR(1),"^",3)=0:"NO",1:IBU) W !?4,"Use Non-PTF Codes?",?23,": ",$S($P(IBEPAR(1),"^",15)=1:"YES",$P(IBEPAR(1),"^",15)=0:"NO",1:IBU)
W ?47,"Ask HINQ in MCCR? : ",$S($P(IBEPAR(1),"^",16)=1:"YES",$P(IBEPAR(1),"^",16)=0:"NO",1:IBU),!
W ?4,"Use OP CPT screen? : ",$S($P(IBEPAR(1),"^",17):"YES",'$P(IBEPAR(1),"^",17):"NO",1:IBU)
W ?47,"Default ASC Rev. Cd: " S X=$G(^DGCR(399.2,+$P(IBEPAR(1),"^",18),0)) W $S($P(X,"^")]"":$P(X,"^"),1:IBU),!
W ?4,"Xfer Proc to Sched?: "_$S($P(IBEPAR(1),"^",19)=1:"YES",$P(IBEPAR(1),"^",19)=0:"NO",1:IBU)
W ?47,"Per Diem Start Date: " S Y=$P(IBEPAR(0),"^",12) D D^DIQ W Y,!
W ?4,"Default RX Rev. Cd : " S X=$G(^DGCR(399.2,+$P(IBEPAR(1),"^",28),0)) W $S($P(X,"^")]"":$P(X,"^"),1:IBU)
W ?42,"Suppress MT Ins Bulletin: ",$S($P(IBEPAR(0),"^",15)=1:"YES",$P(IBEPAR(0),"^",15)=0:"NO",1:IBU),!
W ?4,"Default RX Dx Cd : " S X=$G(^ICD9(+$P(IBEPAR(1),"^",29),0)) W $S($P(X,"^")]"":$P(X,"^"),1:IBU)
W ?47,"Default RX CPT Cd : " S X=$G(^ICPT(+$P(IBEPAR(1),"^",30),0)) W $S($P(X,"^")]"":$P(X,"^"),1:IBU),!
;
4 S Z=4,IBW=1 X IBWW W " '001' for Total? : "_$S($P(IBEPAR(1),"^",10)=1:"YES",$P(IBEPAR(1),"^",10)=0:"NO",1:IBU)
W ?47,"Hold MT Bills W/Ins: ",$S($P(IBEPAR(1),"^",20)=1:"YES",$P(IBEPAR(1),"^",20)=0:"NO",1:IBU)
W !?4,"Remark on each bill",?23,": ",$S($P(IBEPAR(1),"^",4)]"":$E($P(IBEPAR(1),"^",4),1,21),1:IBU)
W ?47,"UB-92 Address Col : " W $S($P(IBEPAR(1),U,31)]"":$P(IBEPAR(1),"^",31),1:IBU)
W !?4,"Cancellation Remark",?23,": ",$S($P(IBEPAR(2),"^",7)]"":$E($P(IBEPAR(2),"^",7),1,21),1:IBU)
W ?47,"HCFA 1500 Addr Col : " W $S($P(IBEPAR(1),U,27)]"":$P(IBEPAR(1),"^",27),1:IBU)
;
W !?4,"Cancelled Mailgroup",?23,": ",$S($P(IBEPAR(1),"^",7):$P($G(^XMB(3.8,+$P(IBEPAR(1),"^",7),0)),"^",1),1:IBU)
;
W ?47,"Disap. Mailgroup : ",$S($P(IBEPAR(1),"^",9):$P($G(^XMB(3.8,+$P(IBEPAR(1),"^",9),0)),"^"),1:IBU),!
W ?4,"Copay Mailgroup",?23,": ",$S($P(IBEPAR(0),"^",9):$P($G(^XMB(3.8,+$P(IBEPAR(0),"^",9),0)),"^"),1:IBU)
W ?47,"Cat C Mailgroup : ",$S($P(IBEPAR(0),"^",11):$P($G(^XMB(3.8,+$P(IBEPAR(0),"^",11),0)),"^"),1:IBU)
;
5 ;
S Z=5,IBW=1 X IBWW W " Agent Cashier",?23,": ",$P(IBEPAR(2),"^",1)
W ", ",$P(IBEPAR(2),"^",3),", "
W $S($P(IBEPAR(2),"^",4):$P(^DIC(5,$P(IBEPAR(2),"^",4),0),"^",2),1:"")
W " ",$P(IBEPAR(2),"^",5)
W !?4,"Phone",?23,": ",$S($P(IBEPAR(2),"^",6)]"":$P(IBEPAR(2),"^",6),1:IBU)
W ?47,"Default Form Type : " S X=$G(^IBE(353,+$P(IBEPAR(1),"^",26),0)) W $S($P(X,"^")]"":$P(X,"^"),1:IBU)
CH D ^IBEPAR1 I $D(IBSCA) G IBEPAR
Q K IBEPAR,IBSCPP,IBSUP,IBSR,IBPAR,IBU,IBUN,IBV1,IBVI,IBVV,IBVO,IBW,IBWW,DIK,I,X,Y Q
;IBEPAR
IBEPAR ;ALB/AAS - MCCR SITE PARAMETER ENTER/EDIT ;26-MAR-92
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
% ;
+1 SET IBPAR=1
SET IBV1="00000"
SET IBSR="PAR"
SET IBSR1=""
FOR I=0,1,2
SET IBEPAR(I)=$SELECT($DATA(^IBE(350.9,1,I)):^(I),1:"")
+2 DO ^IBCSCU
+3 SET L=""
SET $PIECE(L,"=",80)=""
+4 IF $DATA(IBPAR)
SET X="MEDICAL CARE COST RECOVERY PARAMETER ENTER/EDIT"
WRITE @IOF,?17,IBVI,X,IBVO,!,L
+5 ;
1 SET Z=1
SET IBW=1
XECUTE IBWW
WRITE " Medical Center Name: "_$PIECE($GET(^DIC(4,+$PIECE(IBEPAR(0),"^",2),0)),"^"),?47,"Federal Tax #",?66,": ",$SELECT($PIECE(IBEPAR(1),"^",5)]"":$PIECE(IBEPAR(1),"^",5),1:IBU)
+1 WRITE !?4,"Default BC/BS #",?23,": ",$SELECT($PIECE(IBEPAR(1),"^",6)]"":$PIECE(IBEPAR(1),"^",6),1:IBU)
+2 WRITE ?47,"Medicare Number",?66,": ",$SELECT($PIECE(IBEPAR(1),"^",21)]"":$PIECE(IBEPAR(1),"^",21),1:IBU)
+3 WRITE !?4,"MAS Service Pointer",?23,": ",$EXTRACT($SELECT($PIECE(IBEPAR(1),"^",14)]""&($DATA(^DIC(49,+$PIECE(IBEPAR(1),"^",14),0))):$PIECE(^(0),"^",1),1:IBU),1,20)
+4 WRITE ?47,"Default Division",?66,": ",$EXTRACT($SELECT($PIECE(IBEPAR(1),"^",25)]"":$PIECE($GET(^DG(40.8,+$PIECE(IBEPAR(1),"^",25),0)),"^"),1:IBU),1,12),!
+5 ;
2 SET Z=2
SET IBW=1
XECUTE IBWW
WRITE " Bill Signer Name : "_$SELECT($PIECE(IBEPAR(1),"^",1)]"":$PIECE(IBEPAR(1),"^",1),1:IBU)
+1 WRITE ?47,"Title: ",$SELECT($PIECE(IBEPAR(1),"^",2)]"":$PIECE(IBEPAR(1),"^",2),1:IBU)
+2 WRITE !?4,"Billing Supervisor",?23,": "
SET IBSUP=$SELECT($PIECE(IBEPAR(1),"^",8)]"":$PIECE(IBEPAR(1),"^",8),1:IBU)
IF IBSUP'=IBU
SET IBSUP=$PIECE(^VA(200,IBSUP,0),"^",1)
+3 IF IBSUP'=IBU
WRITE $PIECE(IBSUP,",",2)," ",$PIECE(IBSUP,",",1),!
IF IBSUP=IBU
WRITE IBU,!
+4 ;
3 SET Z=3
SET IBW=1
XECUTE IBWW
WRITE " Multiple Form Types: "_$SELECT($PIECE(IBEPAR(1),"^",22)=1:"YES",$PIECE(IBEPAR(1),"^",11)=0:"NO",1:IBU)
+1 WRITE ?47,"Initiator Authorize: ",$SELECT($PIECE(IBEPAR(1),"^",23)=1:"YES",$PIECE(IBEPAR(1),"^",3)=0:"NO",1:IBU)
WRITE !?4,"Use Non-PTF Codes?",?23,": ",$SELECT($PIECE(IBEPAR(1),"^",15)=1:"YES",$PIECE(IBEPAR(1),"^",15)=0:"NO",1:IBU)
+2 WRITE ?47,"Ask HINQ in MCCR? : ",$SELECT($PIECE(IBEPAR(1),"^",16)=1:"YES",$PIECE(IBEPAR(1),"^",16)=0:"NO",1:IBU),!
+3 WRITE ?4,"Use OP CPT screen? : ",$SELECT($PIECE(IBEPAR(1),"^",17):"YES",'$PIECE(IBEPAR(1),"^",17):"NO",1:IBU)
+4 WRITE ?47,"Default ASC Rev. Cd: "
SET X=$GET(^DGCR(399.2,+$PIECE(IBEPAR(1),"^",18),0))
WRITE $SELECT($PIECE(X,"^")]"":$PIECE(X,"^"),1:IBU),!
+5 WRITE ?4,"Xfer Proc to Sched?: "_$SELECT($PIECE(IBEPAR(1),"^",19)=1:"YES",$PIECE(IBEPAR(1),"^",19)=0:"NO",1:IBU)
+6 WRITE ?47,"Per Diem Start Date: "
SET Y=$PIECE(IBEPAR(0),"^",12)
DO D^DIQ
WRITE Y,!
+7 WRITE ?4,"Default RX Rev. Cd : "
SET X=$GET(^DGCR(399.2,+$PIECE(IBEPAR(1),"^",28),0))
WRITE $SELECT($PIECE(X,"^")]"":$PIECE(X,"^"),1:IBU)
+8 WRITE ?42,"Suppress MT Ins Bulletin: ",$SELECT($PIECE(IBEPAR(0),"^",15)=1:"YES",$PIECE(IBEPAR(0),"^",15)=0:"NO",1:IBU),!
+9 WRITE ?4,"Default RX Dx Cd : "
SET X=$GET(^ICD9(+$PIECE(IBEPAR(1),"^",29),0))
WRITE $SELECT($PIECE(X,"^")]"":$PIECE(X,"^"),1:IBU)
+10 WRITE ?47,"Default RX CPT Cd : "
SET X=$GET(^ICPT(+$PIECE(IBEPAR(1),"^",30),0))
WRITE $SELECT($PIECE(X,"^")]"":$PIECE(X,"^"),1:IBU),!
+11 ;
4 SET Z=4
SET IBW=1
XECUTE IBWW
WRITE " '001' for Total? : "_$SELECT($PIECE(IBEPAR(1),"^",10)=1:"YES",$PIECE(IBEPAR(1),"^",10)=0:"NO",1:IBU)
+1 WRITE ?47,"Hold MT Bills W/Ins: ",$SELECT($PIECE(IBEPAR(1),"^",20)=1:"YES",$PIECE(IBEPAR(1),"^",20)=0:"NO",1:IBU)
+2 WRITE !?4,"Remark on each bill",?23,": ",$SELECT($PIECE(IBEPAR(1),"^",4)]"":$EXTRACT($PIECE(IBEPAR(1),"^",4),1,21),1:IBU)
+3 WRITE ?47,"UB-92 Address Col : "
WRITE $SELECT($PIECE(IBEPAR(1),U,31)]"":$PIECE(IBEPAR(1),"^",31),1:IBU)
+4 WRITE !?4,"Cancellation Remark",?23,": ",$SELECT($PIECE(IBEPAR(2),"^",7)]"":$EXTRACT($PIECE(IBEPAR(2),"^",7),1,21),1:IBU)
+5 WRITE ?47,"HCFA 1500 Addr Col : "
WRITE $SELECT($PIECE(IBEPAR(1),U,27)]"":$PIECE(IBEPAR(1),"^",27),1:IBU)
+6 ;
+7 WRITE !?4,"Cancelled Mailgroup",?23,": ",$SELECT($PIECE(IBEPAR(1),"^",7):$PIECE($GET(^XMB(3.8,+$PIECE(IBEPAR(1),"^",7),0)),"^",1),1:IBU)
+8 ;
+9 WRITE ?47,"Disap. Mailgroup : ",$SELECT($PIECE(IBEPAR(1),"^",9):$PIECE($GET(^XMB(3.8,+$PIECE(IBEPAR(1),"^",9),0)),"^"),1:IBU),!
+10 WRITE ?4,"Copay Mailgroup",?23,": ",$SELECT($PIECE(IBEPAR(0),"^",9):$PIECE($GET(^XMB(3.8,+$PIECE(IBEPAR(0),"^",9),0)),"^"),1:IBU)
+11 WRITE ?47,"Cat C Mailgroup : ",$SELECT($PIECE(IBEPAR(0),"^",11):$PIECE($GET(^XMB(3.8,+$PIECE(IBEPAR(0),"^",11),0)),"^"),1:IBU)
+12 ;
5 ;
+1 SET Z=5
SET IBW=1
XECUTE IBWW
WRITE " Agent Cashier",?23,": ",$PIECE(IBEPAR(2),"^",1)
+2 WRITE ", ",$PIECE(IBEPAR(2),"^",3),", "
+3 WRITE $SELECT($PIECE(IBEPAR(2),"^",4):$PIECE(^DIC(5,$PIECE(IBEPAR(2),"^",4),0),"^",2),1:"")
+4 WRITE " ",$PIECE(IBEPAR(2),"^",5)
+5 WRITE !?4,"Phone",?23,": ",$SELECT($PIECE(IBEPAR(2),"^",6)]"":$PIECE(IBEPAR(2),"^",6),1:IBU)
+6 WRITE ?47,"Default Form Type : "
SET X=$GET(^IBE(353,+$PIECE(IBEPAR(1),"^",26),0))
WRITE $SELECT($PIECE(X,"^")]"":$PIECE(X,"^"),1:IBU)
CH DO ^IBEPAR1
IF $DATA(IBSCA)
GOTO IBEPAR
Q KILL IBEPAR,IBSCPP,IBSUP,IBSR,IBPAR,IBU,IBUN,IBV1,IBVI,IBVV,IBVO,IBW,IBWW,DIK,I,X,Y
QUIT
+1 ;IBEPAR
