IBJPB ;ALB/MAF,ARH - IBSP AUTOMATED BILLING SCREEN ; 28-DEC-1995
;;Version 2.0 ; INTEGRATED BILLING ;**39,55**; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN ; -- main entry point for IBJP AUTO BILLING screen
D EN^VALM("IBJP AUTO BILLING")
Q
;
HDR ; -- header code
S VALMHDR(1)="Only authorized persons may edit this data."
Q
;
INIT ; -- init variables and list array
K ^TMP("IBJPB",$J)
D BLD
Q
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("IBJPB",$J)
D CLEAR^VALM1
Q
;
BLD ; - build screen array, no variables required
N IBNC,IBTC,IBTW,IBSW,IBLN,IBX,IBLR,IBJDATA,IBGRPB,IBGRPE,IBON
S IBNC(1)=11,IBTC(1)=2,IBTW(1)=23,IBSW(1)=13,IBNC(2)=50,IBTC(2)=41,IBTW(2)=23,IBSW(2)=13
;
S (VALMCNT,IBLN)=1,IBLR=1,IBLN=$$SET("","",IBLN,IBLR),IBGRPB=IBLN
;
; - general parameters controlling AB
S IBJDATA=$G(^IBE(350.9,1,7))
S IBLN=$$SETN("GENERAL PARAMETERS",IBLN,IBLR,1)
S IBLN=$$SET("Auto Biller Frequency: ",+$P(IBJDATA,"^",1),IBLN,IBLR)
S IBLN=$$SET("Date Last Completed: ",$$DATE^IBJU1($P(IBJDATA,"^",2)),IBLN,IBLR)
S IBLN=$$SET("Inpatient Status: ",$$EXSET^IBJU1($P(IBJDATA,"^",3),350.9,7.03),IBLN,IBLR)
;
; - inpatient, outpatient, and prescription refill parameters
F IBX=1,2,4 D
. I IBLR=1 S IBLN=IBGRPB,IBGRPE=IBLN,IBLR=2
. E S (IBLN,VALMCNT)=$S(IBLN>IBGRPE:IBLN,1:IBGRPE),IBLN=$$SET("","",IBLN,IBLR),IBGRPB=IBLN,IBLR=1
. ;
. S IBX=$O(^IBE(356.6,"AC",+IBX,0)),IBJDATA=$G(^IBE(356.6,+IBX,0))
. S IBLN=$$SETN($P(IBJDATA,U,1),IBLN,IBLR,1),IBON=+$P(IBJDATA,"^",4)
. S IBLN=$$SET("Automate Billing: ",$S(+IBON:"YES",1:"NO"),IBLN,IBLR)
. S IBLN=$$SET("Billing Cycle: ",$S(+$P(IBJDATA,"^",5):$P(IBJDATA,"^",5),+IBON:"Monthly",1:""),IBLN,IBLR)
. S IBLN=$$SET("Days Delay: ",$P(IBJDATA,"^",6),IBLN,IBLR)
;
S (IBLN,VALMCNT)=$S(IBLN>IBGRPE:IBLN,1:IBGRPE)-1
Q
;
SET(TTL,DATA,LN,LR) ;
N IBY
S IBY=$J(TTL,IBTW(LR))_DATA D SET1(IBY,LN,IBTC(LR),(IBTW(LR)+IBSW(LR)))
S LN=LN+1
Q LN
;
SETN(TTL,LN,LR,RV) ;
N IBY
S IBY=" "_TTL_" " D SET1(IBY,LN,IBNC(LR),$L(IBY),$G(RV))
S LN=LN+1
Q LN
;
SET1(STR,LN,COL,WD,RV) ; set up TMP array with screen data
N IBX S IBX=$G(^TMP("IBJPB",$J,LN,0))
S IBX=$$SETSTR^VALM1(STR,IBX,COL,WD)
D SET^VALM10(LN,IBX) I $G(RV)'="" D CNTRL^VALM10(LN,COL,WD,IORVON,IORVOFF)
Q
;
ABEDIT(IBJABP) ; -- IBJP AB EDIT ACTIONS (IP,OP,RX): Edit Automated Billing Parameters
; Entry Code (356.6,.08) of CT Type to edit passed in
D FULL^VALM1
S IBJABP=$O(^IBE(356.6,"AC",IBJABP,0)) I 'IBJABP S VALMSG="Parameter set not found."
I +IBJABP S DIE="^IBE(356.6,",DA=+IBJABP,DR=".04;.05;.06" D ^DIE K DIE,DIC,DA,DR,X,Y
D INIT S VALMBCK="R"
Q
;
ABGEDIT ; -- IBJP AB GENERAL EDIT ACTION (GP): Edit General Automated Billing Parameters
D FULL^VALM1 N IBFR,IBFR2,IBZWRT,DIE,DIC,DA,DR,X,Y,DIR,DIRUT
S IBFR=$P($G(^IBE(350.9,1,7)),U,1)
S DIE="^IBE(350.9,",DA=1,DR="7.01;7.03" D ^DIE I $D(Y) K DIE,DIC,DA,DR,X,Y
S IBFR2=$P($G(^IBE(350.9,1,7)),U,1)
S IBZWRT=1 D:'IBFR CLEAN^IBCDC D:'IBFR2 ABOFF^IBCDC I 'IBZWRT S DIR(0)="E" D ^DIR K DIR
D INIT S VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJPB 3166 printed Nov 22, 2024@17:33:31 Page 2
IBJPB ;ALB/MAF,ARH - IBSP AUTOMATED BILLING SCREEN ; 28-DEC-1995
+1 ;;Version 2.0 ; INTEGRATED BILLING ;**39,55**; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
EN ; -- main entry point for IBJP AUTO BILLING screen
+1 DO EN^VALM("IBJP AUTO BILLING")
+2 QUIT
+3 ;
HDR ; -- header code
+1 SET VALMHDR(1)="Only authorized persons may edit this data."
+2 QUIT
+3 ;
INIT ; -- init variables and list array
+1 KILL ^TMP("IBJPB",$JOB)
+2 DO BLD
+3 QUIT
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("IBJPB",$JOB)
+2 DO CLEAR^VALM1
+3 QUIT
+4 ;
BLD ; - build screen array, no variables required
+1 NEW IBNC,IBTC,IBTW,IBSW,IBLN,IBX,IBLR,IBJDATA,IBGRPB,IBGRPE,IBON
+2 SET IBNC(1)=11
SET IBTC(1)=2
SET IBTW(1)=23
SET IBSW(1)=13
SET IBNC(2)=50
SET IBTC(2)=41
SET IBTW(2)=23
SET IBSW(2)=13
+3 ;
+4 SET (VALMCNT,IBLN)=1
SET IBLR=1
SET IBLN=$$SET("","",IBLN,IBLR)
SET IBGRPB=IBLN
+5 ;
+6 ; - general parameters controlling AB
+7 SET IBJDATA=$GET(^IBE(350.9,1,7))
+8 SET IBLN=$$SETN("GENERAL PARAMETERS",IBLN,IBLR,1)
+9 SET IBLN=$$SET("Auto Biller Frequency: ",+$PIECE(IBJDATA,"^",1),IBLN,IBLR)
+10 SET IBLN=$$SET("Date Last Completed: ",$$DATE^IBJU1($PIECE(IBJDATA,"^",2)),IBLN,IBLR)
+11 SET IBLN=$$SET("Inpatient Status: ",$$EXSET^IBJU1($PIECE(IBJDATA,"^",3),350.9,7.03),IBLN,IBLR)
+12 ;
+13 ; - inpatient, outpatient, and prescription refill parameters
+14 FOR IBX=1,2,4
Begin DoDot:1
+15 IF IBLR=1
SET IBLN=IBGRPB
SET IBGRPE=IBLN
SET IBLR=2
+16 IF '$TEST
SET (IBLN,VALMCNT)=$SELECT(IBLN>IBGRPE:IBLN,1:IBGRPE)
SET IBLN=$$SET("","",IBLN,IBLR)
SET IBGRPB=IBLN
SET IBLR=1
+17 ;
+18 SET IBX=$ORDER(^IBE(356.6,"AC",+IBX,0))
SET IBJDATA=$GET(^IBE(356.6,+IBX,0))
+19 SET IBLN=$$SETN($PIECE(IBJDATA,U,1),IBLN,IBLR,1)
SET IBON=+$PIECE(IBJDATA,"^",4)
+20 SET IBLN=$$SET("Automate Billing: ",$SELECT(+IBON:"YES",1:"NO"),IBLN,IBLR)
+21 SET IBLN=$$SET("Billing Cycle: ",$SELECT(+$PIECE(IBJDATA,"^",5):$PIECE(IBJDATA,"^",5),+IBON:"Monthly",1:""),IBLN,IBLR)
+22 SET IBLN=$$SET("Days Delay: ",$PIECE(IBJDATA,"^",6),IBLN,IBLR)
End DoDot:1
+23 ;
+24 SET (IBLN,VALMCNT)=$SELECT(IBLN>IBGRPE:IBLN,1:IBGRPE)-1
+25 QUIT
+26 ;
SET(TTL,DATA,LN,LR) ;
+1 NEW IBY
+2 SET IBY=$JUSTIFY(TTL,IBTW(LR))_DATA
DO SET1(IBY,LN,IBTC(LR),(IBTW(LR)+IBSW(LR)))
+3 SET LN=LN+1
+4 QUIT LN
+5 ;
SETN(TTL,LN,LR,RV) ;
+1 NEW IBY
+2 SET IBY=" "_TTL_" "
DO SET1(IBY,LN,IBNC(LR),$LENGTH(IBY),$GET(RV))
+3 SET LN=LN+1
+4 QUIT LN
+5 ;
SET1(STR,LN,COL,WD,RV) ; set up TMP array with screen data
+1 NEW IBX
SET IBX=$GET(^TMP("IBJPB",$JOB,LN,0))
+2 SET IBX=$$SETSTR^VALM1(STR,IBX,COL,WD)
+3 DO SET^VALM10(LN,IBX)
IF $GET(RV)'=""
DO CNTRL^VALM10(LN,COL,WD,IORVON,IORVOFF)
+4 QUIT
+5 ;
ABEDIT(IBJABP) ; -- IBJP AB EDIT ACTIONS (IP,OP,RX): Edit Automated Billing Parameters
+1 ; Entry Code (356.6,.08) of CT Type to edit passed in
+2 DO FULL^VALM1
+3 SET IBJABP=$ORDER(^IBE(356.6,"AC",IBJABP,0))
IF 'IBJABP
SET VALMSG="Parameter set not found."
+4 IF +IBJABP
SET DIE="^IBE(356.6,"
SET DA=+IBJABP
SET DR=".04;.05;.06"
DO ^DIE
KILL DIE,DIC,DA,DR,X,Y
+5 DO INIT
SET VALMBCK="R"
+6 QUIT
+7 ;
ABGEDIT ; -- IBJP AB GENERAL EDIT ACTION (GP): Edit General Automated Billing Parameters
+1 DO FULL^VALM1
NEW IBFR,IBFR2,IBZWRT,DIE,DIC,DA,DR,X,Y,DIR,DIRUT
+2 SET IBFR=$PIECE($GET(^IBE(350.9,1,7)),U,1)
+3 SET DIE="^IBE(350.9,"
SET DA=1
SET DR="7.01;7.03"
DO ^DIE
IF $DATA(Y)
KILL DIE,DIC,DA,DR,X,Y
+4 SET IBFR2=$PIECE($GET(^IBE(350.9,1,7)),U,1)
+5 SET IBZWRT=1
if 'IBFR
DO CLEAN^IBCDC
if 'IBFR2
DO ABOFF^IBCDC
IF 'IBZWRT
SET DIR(0)="E"
DO ^DIR
KILL DIR
+6 DO INIT
SET VALMBCK="R"
+7 QUIT
