IBCOIVM2 ;ALB/NLR - IB BILLING ACTIVITY (BULLETIN) ; 4-MAY-94
;;Version 2.0 ; INTEGRATED BILLING ;**6**; 21-MAR-94
;
BULL ; Generate a bulletin containing the report.
S XMSUB="IVM BILLING ACTIVITY"
S XMDUZ="INTEGRATED BILLING PACKAGE"
S XMTEXT="IBT("
S XMY($P($G(^IBE(350.9,1,4)),"^",7))=""
S XMY(DUZ)=""
;
; - set up report header
S IBT(1)=$J("",55)_"IVM BILLING ACTIVITY"
S IBT(2)=" "
S X=$$SITE^VASITE
S X=$E("Facility: "_$P(X,"^",2)_" ("_$P(X,"^",3)_")"_$J("",100),1,112)
S IBT(3)=X_"Run Date: "_$$DAT1^IBOUTL(DT)
S X="Types ==> I:Inpatient, O:Outpatient, P:Prosthetics, R:Pharmacy Refill"
S IBT(4)=X_$J("",12)_"Note: '*' after the Bill # denotes a closed bill"
S IBT(5)=" "
S IBT(6)=$$DASH^IBCOIVM1
S IBT(7)=$J("",55)_"Bill"_$J("",30)_"Date"_$J("",14)_"Amt"_$J("",15)_"Amt"
S X=" Patient Name"_$J("",15)_"SSN Bill # Type Bill From - To"
S IBT(8)=X_" Generated"_$J("",10)_"Billed"_$J("",11)_"Collected"
S IBT(9)=$$DASH^IBCOIVM1,IBC=9
I '$D(^TMP("IBOIVM",$J)) D SET(" ") S IBX=$J("",25)_"<< NO PATIENTS WITH POLICIES IDENTIFIED BY IVM >>" D SET(IBX) G DELQ
;
; - set up report body
S (IBAB,IBAC)=0
S IBNA="" F S IBNA=$O(^TMP("IBOIVM",$J,IBNA)) Q:IBNA="" D
.D SET(" ")
.S IBX=$E($E($P(IBNA,"^"),1,25)_$J("",25),1,25)_" "
.S IBX=IBX_$E($P(IBNA,"^",2)_$J("",14),1,14)
.I $D(^TMP("IBOIVM",$J,IBNA,0)) D SET(IBX_$J("",12)_"<< BILLS NOT YET GENERATED AGAINST IVM POLICIES >>") Q
.S (IBF,IBIFN)=0 F S IBIFN=$O(^TMP("IBOIVM",$J,IBNA,IBIFN)) Q:'IBIFN D
..F IBI=0,"S","U" S IBND(IBI)=$G(^DGCR(399,IBIFN,IBI))
..S:IBF IBX=$J("",41)
..S IBX=IBX_$E($P(IBND(0),"^")_$J("",10),1,10)
..S IBX=IBX_$S($$CLO^PRCAFN(IBIFN)>0:"*",1:" ")_" "
..S IBX=IBX_$E($$BTYP^IBCOIVM1(IBIFN,IBND(0))_" ")_" "
..S IBX=IBX_$E($$DAT1^IBOUTL(+IBND("U"))_$J("",8),1,8)_" "
..S IBX=IBX_$E($$DAT1^IBOUTL($P(IBND("U"),"^",2))_$J("",8),1,8)_" "
..S IBX=IBX_$E($$DAT1^IBOUTL($P(IBND("S"),"^",12))_$J("",8),1,8)
..S IBZ=$$ORI^PRCAFN(IBIFN),IBAB=IBAB+IBZ
..S IBX=IBX_$J("",8)_$J(IBZ,10,2)
..S IBZ=$$TPR^PRCAFN(IBIFN),IBAC=IBAC+IBZ
..S IBX=IBX_" "_$J(IBZ,10,2)
..D SET(IBX)
..S IBF=1
;
I 'IBAB,'IBAC G DELQ
; - set up total amounts billed and collected
S IBX=$J("",102)_"___________ ___________"
D SET(IBX)
D SET(" ")
S IBX=$J("",63)_"Total Amounts Billed and Collected:"
S X=IBAB,X2="2$",X3=16 D COMMA^%DTC S IBX=IBX_X
S X=IBAC,X2="2$",X3=16 D COMMA^%DTC S IBX=IBX_X
D SET(IBX)
;
; - deliver and quit
DELQ D ^XMD
K IBAB,IBAC,IBC,IBF,IBI,IBIFN,IBNA,IBT,IBX,IBZ,X,X2,X3,XMSUB,XMDUZ,XMY,XMTEXT,Y
Q
;
;
SET(X) ; Set X into the IBT( array.
S IBC=IBC+1,IBT(IBC)=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCOIVM2 2705 printed Dec 13, 2024@02:18:15 Page 2
IBCOIVM2 ;ALB/NLR - IB BILLING ACTIVITY (BULLETIN) ; 4-MAY-94
+1 ;;Version 2.0 ; INTEGRATED BILLING ;**6**; 21-MAR-94
+2 ;
BULL ; Generate a bulletin containing the report.
+1 SET XMSUB="IVM BILLING ACTIVITY"
+2 SET XMDUZ="INTEGRATED BILLING PACKAGE"
+3 SET XMTEXT="IBT("
+4 SET XMY($PIECE($GET(^IBE(350.9,1,4)),"^",7))=""
+5 SET XMY(DUZ)=""
+6 ;
+7 ; - set up report header
+8 SET IBT(1)=$JUSTIFY("",55)_"IVM BILLING ACTIVITY"
+9 SET IBT(2)=" "
+10 SET X=$$SITE^VASITE
+11 SET X=$EXTRACT("Facility: "_$PIECE(X,"^",2)_" ("_$PIECE(X,"^",3)_")"_$JUSTIFY("",100),1,112)
+12 SET IBT(3)=X_"Run Date: "_$$DAT1^IBOUTL(DT)
+13 SET X="Types ==> I:Inpatient, O:Outpatient, P:Prosthetics, R:Pharmacy Refill"
+14 SET IBT(4)=X_$JUSTIFY("",12)_"Note: '*' after the Bill # denotes a closed bill"
+15 SET IBT(5)=" "
+16 SET IBT(6)=$$DASH^IBCOIVM1
+17 SET IBT(7)=$JUSTIFY("",55)_"Bill"_$JUSTIFY("",30)_"Date"_$JUSTIFY("",14)_"Amt"_$JUSTIFY("",15)_"Amt"
+18 SET X=" Patient Name"_$JUSTIFY("",15)_"SSN Bill # Type Bill From - To"
+19 SET IBT(8)=X_" Generated"_$JUSTIFY("",10)_"Billed"_$JUSTIFY("",11)_"Collected"
+20 SET IBT(9)=$$DASH^IBCOIVM1
SET IBC=9
+21 IF '$DATA(^TMP("IBOIVM",$JOB))
DO SET(" ")
SET IBX=$JUSTIFY("",25)_"<< NO PATIENTS WITH POLICIES IDENTIFIED BY IVM >>"
DO SET(IBX)
GOTO DELQ
+22 ;
+23 ; - set up report body
+24 SET (IBAB,IBAC)=0
+25 SET IBNA=""
FOR
SET IBNA=$ORDER(^TMP("IBOIVM",$JOB,IBNA))
if IBNA=""
QUIT
Begin DoDot:1
+26 DO SET(" ")
+27 SET IBX=$EXTRACT($EXTRACT($PIECE(IBNA,"^"),1,25)_$JUSTIFY("",25),1,25)_" "
+28 SET IBX=IBX_$EXTRACT($PIECE(IBNA,"^",2)_$JUSTIFY("",14),1,14)
+29 IF $DATA(^TMP("IBOIVM",$JOB,IBNA,0))
DO SET(IBX_$JUSTIFY("",12)_"<< BILLS NOT YET GENERATED AGAINST IVM POLICIES >>")
QUIT
+30 SET (IBF,IBIFN)=0
FOR
SET IBIFN=$ORDER(^TMP("IBOIVM",$JOB,IBNA,IBIFN))
if 'IBIFN
QUIT
Begin DoDot:2
+31 FOR IBI=0,"S","U"
SET IBND(IBI)=$GET(^DGCR(399,IBIFN,IBI))
+32 if IBF
SET IBX=$JUSTIFY("",41)
+33 SET IBX=IBX_$EXTRACT($PIECE(IBND(0),"^")_$JUSTIFY("",10),1,10)
+34 SET IBX=IBX_$SELECT($$CLO^PRCAFN(IBIFN)>0:"*",1:" ")_" "
+35 SET IBX=IBX_$EXTRACT($$BTYP^IBCOIVM1(IBIFN,IBND(0))_" ")_" "
+36 SET IBX=IBX_$EXTRACT($$DAT1^IBOUTL(+IBND("U"))_$JUSTIFY("",8),1,8)_" "
+37 SET IBX=IBX_$EXTRACT($$DAT1^IBOUTL($PIECE(IBND("U"),"^",2))_$JUSTIFY("",8),1,8)_" "
+38 SET IBX=IBX_$EXTRACT($$DAT1^IBOUTL($PIECE(IBND("S"),"^",12))_$JUSTIFY("",8),1,8)
+39 SET IBZ=$$ORI^PRCAFN(IBIFN)
SET IBAB=IBAB+IBZ
+40 SET IBX=IBX_$JUSTIFY("",8)_$JUSTIFY(IBZ,10,2)
+41 SET IBZ=$$TPR^PRCAFN(IBIFN)
SET IBAC=IBAC+IBZ
+42 SET IBX=IBX_" "_$JUSTIFY(IBZ,10,2)
+43 DO SET(IBX)
+44 SET IBF=1
End DoDot:2
End DoDot:1
+45 ;
+46 IF 'IBAB
IF 'IBAC
GOTO DELQ
+47 ; - set up total amounts billed and collected
+48 SET IBX=$JUSTIFY("",102)_"___________ ___________"
+49 DO SET(IBX)
+50 DO SET(" ")
+51 SET IBX=$JUSTIFY("",63)_"Total Amounts Billed and Collected:"
+52 SET X=IBAB
SET X2="2$"
SET X3=16
DO COMMA^%DTC
SET IBX=IBX_X
+53 SET X=IBAC
SET X2="2$"
SET X3=16
DO COMMA^%DTC
SET IBX=IBX_X
+54 DO SET(IBX)
+55 ;
+56 ; - deliver and quit
DELQ DO ^XMD
+1 KILL IBAB,IBAC,IBC,IBF,IBI,IBIFN,IBNA,IBT,IBX,IBZ,X,X2,X3,XMSUB,XMDUZ,XMY,XMTEXT,Y
+2 QUIT
+3 ;
+4 ;
SET(X) ; Set X into the IBT( array.
+1 SET IBC=IBC+1
SET IBT(IBC)=X
+2 QUIT
