- 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 Mar 13, 2025@21:23:13 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
