IB20P150 ;LL/ELZ - IB*2.0*150 POST INIT:MILL BILL RX COPAY ;20-FEB-2001
;;2.0;INTEGRATED BILLING;**150**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
POST ;
;
N X,Y
F X="SPOST","TASK","ERROR","FPOST" S Y=$$NEWCP^XPDUTL(X,X_"^IB20P150")
;
; TASK ; task job to init patient accounts
; ERROR ; new error codes in file 350.8
;
Q
;
SPOST ; start post install
N IBA
S IBA(1)="",IBA(2)=" Outpatient Medication Copay Cap Phase I, Post-Install Starting",IBA(3)="" D MES^XPDUTL(.IBA)
Q
;
FPOST ; finish post install
N IBA
S IBA(1)="",IBA(2)=" Outpatient Medication Copay Cap Phase I, Post-Install Complete",IBA(3)="" D MES^XPDUTL(.IBA)
Q
;
;
TASK ; queue off the init task job
N IBA,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK
;
S IBA(1)=""
;
; already scheduled or completed?
I $P(^IBE(350.9,1,0),"^",16) S IBA(2)=" Task already queued or completed!!" G TASKQ
;
S ZTRTN="ADDPT^IB20P150",ZTDESC="IB initialization of patient accounts"
S ZTDTH="58643,64800",ZTIO="" D ^%ZTLOAD
;
I ZTSK>0 S $P(^IBE(350.9,1,0),"^",16)=1,IBA(2)=" Initialization proces scheduled task #"_ZTSK
E S IBA(2)=" Initialization process could NOT be scheduled!!"
;
TASKQ S IBA(3)="" D MES^XPDUTL(.IBA)
Q
;
ERROR ; add new error coes to 350.8
N DIC,X,Y,IBC,IBX,DO,IBT,DA,IBA,DIK
;
S IBC=0,(DIC,DIK)="^IBE(350.8,",DIC(0)=""
F IBX=1:1 S IBT=$P($T(TXT+IBX),";",3) Q:'$L(IBT) I '$D(^IBE(350.8,"AC",$P(IBT,"^",3))) K DO S X=$P(IBT,"^") D FILE^DICN I Y>0 S ^IBE(350.8,+Y,0)=IBT,DA=+Y,IBC=IBC+1 D IX^DIK
;
S IBA(2)=" "_IBC_" entries added to 350.8"
S (IBA(1),IBA(3))=""
;
ERRORQ ;
D MES^XPDUTL(.IBA)
Q
;
ADDPT ; Initialize patient's accounts in file #354.7
;
Q:$P(^IBE(350.9,1,0),"^",16)>1
S $P(^IBE(350.9,1,0),"^",16)=2
;
N DFN,IBCNT,IBT
;
;
S IBCNT=0
;
S DFN=0 F S DFN=$O(^DPT(DFN)) Q:'DFN D
.;
.; do they have treating facilities?
.S IBT=$$TFL^IBARXMU(DFN,.IBT)
.Q:'IBT
.;
.; - count patients and add account
.S IBCNT=IBCNT+1
.D ADD^IBARXMU(DFN)
;
MESSAGE ; send a message indicating completed and update flag
;
N IBSITE,XMSUB,XMDUZ,XMZ,XMY
;
S IBSITE=$$SITE^VASITE
;
S XMSUB="COMPLETED INITIALIZATION OF PATIENT ACCOUNTS"
S XMDUZ="INTEGRATED BILLING ("_+IBSITE_")"
D XMZ^XMA2
S ^XMB(3.9,XMZ,2,1,0)="The Integrated Billing package has completed the initialization of the"
S ^XMB(3.9,XMZ,2,2,0)="IB PATIENT COPAY ACCOUNT file (354.7) for station "_$P(IBSITE,"^",2)_" ("_+IBSITE_")."
S ^XMB(3.9,XMZ,2,3,0)=" "
S ^XMB(3.9,XMZ,2,4,0)="There were "_IBCNT_" patients added to the file."
S ^XMB(3.9,XMZ,2,0)="^3.92^"_4_"^"_4_"^"_DT
S XMY("23829@DOMAIN.EXT")=""
S XMY(DUZ)=""
D ENT1^XMD
;
S $P(^IBE(350.9,1,0),"^",16)=3
Q
;
;
TXT ; text of error messages to add
;;IB CAP UNABLE TO ADD^Unable to add a new rx-copay cap tracking transaction.^IB316^1^2
;;IB CAP POINTER MISSING^No pointer in 350 transaction to 354.71 file.^IB317^1^2
;;IB CAP TRAN FILE LOCK^Unable to lock entry in file 354.71.^IB318^1^2
;;IB CAP PATIENT FILE LOCK^Unable to lock entry in file 354.7.^IB319^1^2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P150 3161 printed Dec 13, 2024@02:01:40 Page 2
IB20P150 ;LL/ELZ - IB*2.0*150 POST INIT:MILL BILL RX COPAY ;20-FEB-2001
+1 ;;2.0;INTEGRATED BILLING;**150**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
POST ;
+1 ;
+2 NEW X,Y
+3 FOR X="SPOST","TASK","ERROR","FPOST"
SET Y=$$NEWCP^XPDUTL(X,X_"^IB20P150")
+4 ;
+5 ; TASK ; task job to init patient accounts
+6 ; ERROR ; new error codes in file 350.8
+7 ;
+8 QUIT
+9 ;
SPOST ; start post install
+1 NEW IBA
+2 SET IBA(1)=""
SET IBA(2)=" Outpatient Medication Copay Cap Phase I, Post-Install Starting"
SET IBA(3)=""
DO MES^XPDUTL(.IBA)
+3 QUIT
+4 ;
FPOST ; finish post install
+1 NEW IBA
+2 SET IBA(1)=""
SET IBA(2)=" Outpatient Medication Copay Cap Phase I, Post-Install Complete"
SET IBA(3)=""
DO MES^XPDUTL(.IBA)
+3 QUIT
+4 ;
+5 ;
TASK ; queue off the init task job
+1 NEW IBA,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK
+2 ;
+3 SET IBA(1)=""
+4 ;
+5 ; already scheduled or completed?
+6 IF $PIECE(^IBE(350.9,1,0),"^",16)
SET IBA(2)=" Task already queued or completed!!"
GOTO TASKQ
+7 ;
+8 SET ZTRTN="ADDPT^IB20P150"
SET ZTDESC="IB initialization of patient accounts"
+9 SET ZTDTH="58643,64800"
SET ZTIO=""
DO ^%ZTLOAD
+10 ;
+11 IF ZTSK>0
SET $PIECE(^IBE(350.9,1,0),"^",16)=1
SET IBA(2)=" Initialization proces scheduled task #"_ZTSK
+12 IF '$TEST
SET IBA(2)=" Initialization process could NOT be scheduled!!"
+13 ;
TASKQ SET IBA(3)=""
DO MES^XPDUTL(.IBA)
+1 QUIT
+2 ;
ERROR ; add new error coes to 350.8
+1 NEW DIC,X,Y,IBC,IBX,DO,IBT,DA,IBA,DIK
+2 ;
+3 SET IBC=0
SET (DIC,DIK)="^IBE(350.8,"
SET DIC(0)=""
+4 FOR IBX=1:1
SET IBT=$PIECE($TEXT(TXT+IBX),";",3)
if '$LENGTH(IBT)
QUIT
IF '$DATA(^IBE(350.8,"AC",$PIECE(IBT,"^",3)))
KILL DO
SET X=$PIECE(IBT,"^")
DO FILE^DICN
IF Y>0
SET ^IBE(350.8,+Y,0)=IBT
SET DA=+Y
SET IBC=IBC+1
DO IX^DIK
+5 ;
+6 SET IBA(2)=" "_IBC_" entries added to 350.8"
+7 SET (IBA(1),IBA(3))=""
+8 ;
ERRORQ ;
+1 DO MES^XPDUTL(.IBA)
+2 QUIT
+3 ;
ADDPT ; Initialize patient's accounts in file #354.7
+1 ;
+2 if $PIECE(^IBE(350.9,1,0),"^",16)>1
QUIT
+3 SET $PIECE(^IBE(350.9,1,0),"^",16)=2
+4 ;
+5 NEW DFN,IBCNT,IBT
+6 ;
+7 ;
+8 SET IBCNT=0
+9 ;
+10 SET DFN=0
FOR
SET DFN=$ORDER(^DPT(DFN))
if 'DFN
QUIT
Begin DoDot:1
+11 ;
+12 ; do they have treating facilities?
+13 SET IBT=$$TFL^IBARXMU(DFN,.IBT)
+14 if 'IBT
QUIT
+15 ;
+16 ; - count patients and add account
+17 SET IBCNT=IBCNT+1
+18 DO ADD^IBARXMU(DFN)
End DoDot:1
+19 ;
MESSAGE ; send a message indicating completed and update flag
+1 ;
+2 NEW IBSITE,XMSUB,XMDUZ,XMZ,XMY
+3 ;
+4 SET IBSITE=$$SITE^VASITE
+5 ;
+6 SET XMSUB="COMPLETED INITIALIZATION OF PATIENT ACCOUNTS"
+7 SET XMDUZ="INTEGRATED BILLING ("_+IBSITE_")"
+8 DO XMZ^XMA2
+9 SET ^XMB(3.9,XMZ,2,1,0)="The Integrated Billing package has completed the initialization of the"
+10 SET ^XMB(3.9,XMZ,2,2,0)="IB PATIENT COPAY ACCOUNT file (354.7) for station "_$PIECE(IBSITE,"^",2)_" ("_+IBSITE_")."
+11 SET ^XMB(3.9,XMZ,2,3,0)=" "
+12 SET ^XMB(3.9,XMZ,2,4,0)="There were "_IBCNT_" patients added to the file."
+13 SET ^XMB(3.9,XMZ,2,0)="^3.92^"_4_"^"_4_"^"_DT
+14 SET XMY("23829@DOMAIN.EXT")=""
+15 SET XMY(DUZ)=""
+16 DO ENT1^XMD
+17 ;
+18 SET $PIECE(^IBE(350.9,1,0),"^",16)=3
+19 QUIT
+20 ;
+21 ;
TXT ; text of error messages to add
+1 ;;IB CAP UNABLE TO ADD^Unable to add a new rx-copay cap tracking transaction.^IB316^1^2
+2 ;;IB CAP POINTER MISSING^No pointer in 350 transaction to 354.71 file.^IB317^1^2
+3 ;;IB CAP TRAN FILE LOCK^Unable to lock entry in file 354.71.^IB318^1^2
+4 ;;IB CAP PATIENT FILE LOCK^Unable to lock entry in file 354.7.^IB319^1^2