406 lines
7.5 KiB
Mathematica
406 lines
7.5 KiB
Mathematica
BPS01P5B ;BHAM ISC/BEE - Post-Install for BPS*1*5 (cont) ;13-DEC-06
|
|
;;1.0;E CLAIMS MGMT ENGINE;**5**;JUN 2004;Build 45
|
|
;;Per VHA Directive 2004-038, this routine should not be modified.
|
|
;
|
|
Q
|
|
;
|
|
; Called by the BPS*1.0*5 Post-Install routine BPS01P5.
|
|
;
|
|
EN N DA,DIK,F,FILE,FIELD,FLDNUM,IFLD,XEC
|
|
F F=2,201,31,56,56011,57,58,59,6,91,9102,99,9902,9903,9905,9904,992271,992273,992274,992279,9901,992388,992389 S FILE=$P($T(@F),";",3) F IFLD=1:1 S FLDNUM=$P($T(@F+IFLD),";",3) Q:FLDNUM="END" D
|
|
.I FLDNUM]"" S DIK="^DD("_FILE_",",DA=FLDNUM,DA(1)=FILE D ^DIK
|
|
.S XEC=$P($T(@F+IFLD),";",4) I XEC]"" X XEC
|
|
Q
|
|
;
|
|
;BPS CLAIMS (#9002313.02)
|
|
2 ;;9002313.02
|
|
;;1.02
|
|
;;1.03
|
|
;;308
|
|
;;315
|
|
;;316
|
|
;;317
|
|
;;318
|
|
;;319
|
|
;;320
|
|
;;327
|
|
;;329
|
|
;;498.09
|
|
;;END
|
|
;
|
|
;BPS CLAIMS - Medication(s) (#9002313.0201)
|
|
201 ;;9002313.0201
|
|
;;.02
|
|
;;404
|
|
;;410
|
|
;;416
|
|
;;422
|
|
;;425
|
|
;;428
|
|
;;432
|
|
;;437
|
|
;;439
|
|
;;440
|
|
;;441
|
|
;;END
|
|
;
|
|
;BPS CERTIFICATION (#9002313.31)
|
|
31 ;;9002313.31
|
|
;;.05
|
|
;;901
|
|
;;END
|
|
;
|
|
;BPS PHARMACIES (#9002313.56)
|
|
56 ;;9002313.56
|
|
;;.04
|
|
;;.05
|
|
;;.06
|
|
;;.07
|
|
;;3001.01
|
|
;;3001.02
|
|
;;END
|
|
;
|
|
;BPS PHARMACIES - PRESCRIBER (#9002313.56011) - Field 1 In OUTPATIENT SITE Multiple
|
|
56011 ;;9002313.56011
|
|
;;;N DIU S DIU=9002313.56011,DIU(0)="DS" D EN^DIU2 K DIU
|
|
;;END
|
|
;
|
|
;BPS LOG OF TRANSACTIONS (#9002313.57)
|
|
57 ;;9002313.57
|
|
;;.13
|
|
;;.14
|
|
;;.15
|
|
;;.16
|
|
;;1.05
|
|
;;1.06
|
|
;;1.14
|
|
;;8
|
|
;;8.0099
|
|
;;12
|
|
;;16
|
|
;;301
|
|
;;302
|
|
;;403
|
|
;;506
|
|
;;601
|
|
;;602
|
|
;;603
|
|
;;701
|
|
;;702
|
|
;;703
|
|
;;802
|
|
;;END
|
|
;
|
|
;BPS STATISTICS (#9002313.58)
|
|
58 ;;9002313.58
|
|
;;301
|
|
;;302
|
|
;;402
|
|
;;403
|
|
;;404
|
|
;;405
|
|
;;406
|
|
;;407
|
|
;;408
|
|
;;409
|
|
;;411
|
|
;;412
|
|
;;413
|
|
;;414
|
|
;;415
|
|
;;419
|
|
;;501
|
|
;;601
|
|
;;602
|
|
;;603
|
|
;;604
|
|
;;701
|
|
;;702
|
|
;;703
|
|
;;704
|
|
;;705
|
|
;;709
|
|
;;719
|
|
;;801
|
|
;;802
|
|
;;803
|
|
;;804
|
|
;;809
|
|
;;901
|
|
;;902
|
|
;;903
|
|
;;904
|
|
;;909
|
|
;;1001
|
|
;;1002
|
|
;;1101
|
|
;;1102
|
|
;;1103
|
|
;;END
|
|
;
|
|
;BPS TRANSACTION (#9002313.59)
|
|
59 ;;9002313.59
|
|
;;.13
|
|
;;.14
|
|
;;.15
|
|
;;.16
|
|
;;1.05
|
|
;;1.06
|
|
;;1.14
|
|
;;8
|
|
;;8.0099
|
|
;;12
|
|
;;16
|
|
;;301
|
|
;;302
|
|
;;403
|
|
;;506
|
|
;;601
|
|
;;602
|
|
;;603
|
|
;;701
|
|
;;702
|
|
;;703
|
|
;;802
|
|
;;END
|
|
;
|
|
;BPS PHARMACIES - INSURER-ASSIGNED # (#9002313.6)/Field 950
|
|
6 ;;9002313.6
|
|
;;;N DIU S DIU=9002313.6,DIU(0)="DS" D EN^DIU2 K DIU
|
|
;;END
|
|
;
|
|
;BPS NCPDP FIELD DEFS (#9002313.91)
|
|
91 ;;9002313.91
|
|
;;.02
|
|
;;.05
|
|
;;END
|
|
;
|
|
;BPS NCPDP FIELD DEFS - FORMAT CODE (#9002313.9102)/Field 20
|
|
9102 ;;9002313.9102
|
|
;;;N DIU S DIU=9002313.9102,DIU(0)="DS" D EN^DIU2 K DIU
|
|
;;END
|
|
;
|
|
;BPS SETUP (#9002313.99)
|
|
99 ;;9002313.99
|
|
;;2.01
|
|
;;115.01
|
|
;;115.02
|
|
;;119.01
|
|
;;119.02
|
|
;;119.03
|
|
;;119.04
|
|
;;119.05
|
|
;;120.01
|
|
;;120.02
|
|
;;120.03
|
|
;;120.04
|
|
;;120.05
|
|
;;120.06
|
|
;;120.07
|
|
;;140.01
|
|
;;140.02
|
|
;;140.03
|
|
;;170.01
|
|
;;230.01
|
|
;;235.01
|
|
;;235.02
|
|
;;235.03
|
|
;;235.04
|
|
;;235.05
|
|
;;235.06
|
|
;;235.07
|
|
;;370.01
|
|
;;370.02
|
|
;;370.03
|
|
;;440.01
|
|
;;577.01
|
|
;;577.02
|
|
;;577.03
|
|
;;577.04
|
|
;;577.05
|
|
;;665.01
|
|
;;665.02
|
|
;;665.03
|
|
;;665.04
|
|
;;667.01
|
|
;;667.02
|
|
;;941
|
|
;;942
|
|
;;943
|
|
;;951
|
|
;;952
|
|
;;953
|
|
;;960.01
|
|
;;960.02
|
|
;;960.03
|
|
;;960.04
|
|
;;960.05
|
|
;;1490
|
|
;;1501
|
|
;;1660.01
|
|
;;1801
|
|
;;1811.01
|
|
;;1960.01
|
|
;;1960.02
|
|
;;1960.03
|
|
;;1980.01
|
|
;;2128.13
|
|
;;2270.01
|
|
;;2270.02
|
|
;;2270.03
|
|
;;2270.04
|
|
;;2270.05
|
|
;;2270.06
|
|
;;2270.11
|
|
;;2270.12
|
|
;;2270.7
|
|
;;2270.8
|
|
;;2270.9
|
|
;;2272.01
|
|
;;2341.02
|
|
;;2341.04
|
|
;;2341.05
|
|
;;2341.06
|
|
;;2341.07
|
|
;;2341.08
|
|
;;2341.09
|
|
;;2341.1
|
|
;;2341.11
|
|
;;2342.01
|
|
;;2342.02
|
|
;;2342.03
|
|
;;2343.01
|
|
;;5151
|
|
;;END
|
|
;
|
|
;BPS SETUP - BILLING LOG FILE (#9002313.9902)/Field 240
|
|
9902 ;;9002313.9902
|
|
;;;N DIU S DIU=9002313.9902,DIU(0)="DS" D EN^DIU2 K DIU
|
|
;;END
|
|
;
|
|
;BPS SETUP - INS RULE ORDER (#9002313.9903)/Field 970.01
|
|
9903 ;;9002313.9903
|
|
;;;N DIU S DIU=9002313.9903,DIU(0)="DS" D EN^DIU2 K DIU
|
|
;;END
|
|
;
|
|
;BPS SETUP - UNBILLABLE NDC # (#9002313.9905)/Field 2128.11
|
|
9905 ;;9002313.9905
|
|
;;;N DIU S DIU=9002313.9905,DIU(0)="DS" D EN^DIU2 K DIU
|
|
;;END
|
|
;
|
|
;BPS SETUP - UNBILLABLE DRUG NAME (#9002313.9904)/Field 2128.12
|
|
9904 ;;9002313.9904
|
|
;;;N DIU S DIU=9002313.9904,DIU(0)="DS" D EN^DIU2 K DIU
|
|
;;END
|
|
;
|
|
;BPS SETUP - WO ARTYPE (#9002313.992271)/Field 2271
|
|
992271 ;;9002313.992271
|
|
;;;N DIU S DIU=9002313.992271,DIU(0)="DS" D EN^DIU2 K DIU
|
|
;;END
|
|
;
|
|
;BPS SETUP - WO CLINIC (#9002313.992273)/Field 2273
|
|
992273 ;;9002313.992273
|
|
;;;N DIU S DIU=9002313.992273,DIU(0)="DS" D EN^DIU2 K DIU
|
|
;;END
|
|
;
|
|
;BPS SETUP - WO DIAG (#9002313.992274)/Field 2274
|
|
992274 ;;9002313.992274
|
|
;;;N DIU S DIU=9002313.992274,DIU(0)="DS" D EN^DIU2 K DIU
|
|
;;END
|
|
;
|
|
;BPS SETUP - WO INSURER (#9002313.992279)/Field 2279
|
|
992279 ;;9002313.992279
|
|
;;;N DIU S DIU=9002313.992279,DIU(0)="DS" D EN^DIU2 K DIU
|
|
;;END
|
|
;
|
|
;BPS SETUP - WORKERS COMP (#9002313.9901)/Field 2380
|
|
9901 ;;9002313.9901
|
|
;;;N DIU S DIU=9002313.9901,DIU(0)="DS" D EN^DIU2 K DIU
|
|
;;END
|
|
;
|
|
;BPS SETUP - WRITE OFF INSURER (#9002313.992388)/Field 2388
|
|
992388 ;;9002313.992388
|
|
;;;N DIU S DIU=9002313.992388,DIU(0)="DS" D EN^DIU2 K DIU
|
|
;;END
|
|
;
|
|
;BPS SETUP - WRITE OFF SELF PAY (#9002313.992389)/Field 2389
|
|
992389 ;;9002313.992389
|
|
;;;N DIU S DIU=9002313.992389,DIU(0)="DS" D EN^DIU2 K DIU
|
|
;;END
|
|
;
|
|
; STAT - This procedure will adjust the Statistics buckets.
|
|
; It should move some claims from the OTHER bucket to the Accepted
|
|
; Reversal bucket
|
|
; It should move claims from the REJECTED bucket to the Rejected
|
|
; Reversal bucket
|
|
;
|
|
STAT ; EP - BPS01P5
|
|
; Initialize variables
|
|
N RESPDT,RESPIEN,POS,REV,RESP,PIECE,RESP1
|
|
N CLOSEDT,CLAIMIEN,DROP
|
|
F PIECE=2:1:8,19 S $P(RESP1,U,PIECE)=0
|
|
;
|
|
; Get date when stats were last cleared
|
|
; If missing, set to 1/1/2001, which preceeds initial ECME install
|
|
; Subtract one second for starting time of loop
|
|
S RESPDT=$$GET1^DIQ(9002313.58,1,2,"I")
|
|
I RESPDT="" S RESPDT=3010101
|
|
S RESPDT=$$FMADD^XLFDT(RESPDT,0,0,0,-1)
|
|
S CLOSEDT=RESPDT
|
|
;
|
|
; Loop trough BPS Response starting with Zero-Out Date,
|
|
; get response and update counters
|
|
F S RESPDT=$O(^BPSR("AE",RESPDT)) Q:RESPDT="" D
|
|
. S RESPIEN="" F S RESPIEN=$O(^BPSR("AE",RESPDT,RESPIEN)) Q:RESPIEN="" D
|
|
.. S POS=$O(^BPSR(RESPIEN,1000,0))
|
|
.. I POS="" Q
|
|
.. S REV=$$GET1^DIQ(9002313.03,RESPIEN,103)="B2"
|
|
.. S RESP=$$GET1^DIQ(9002313.0301,POS_","_RESPIEN,501,"I")
|
|
.. S PIECE=$S(RESP="R"&REV:7,RESP="R":2,RESP="P":3,RESP="D":4,RESP="C":5,RESP="A":6,1:19)
|
|
.. S $P(RESP1,U,PIECE)=$P(RESP1,U,PIECE)+1
|
|
;
|
|
; Loop through Closed Date cross-reference of BPS Claims starting
|
|
; with Zero-Out Date and update Dropped to Paper bucket
|
|
F S CLOSEDT=$O(^BPSC("AG",CLOSEDT)) Q:CLOSEDT="" D
|
|
. S CLAIMIEN="" F S CLAIMIEN=$O(^BPSC("AG",CLOSEDT,CLAIMIEN)) Q:CLAIMIEN="" D
|
|
.. S DROP=$$GET1^DIQ(9002313.02,CLAIMIEN,905,"I")
|
|
.. I DROP="D" S $P(RESP1,U,8)=$P(RESP1,U,8)+1
|
|
;
|
|
; Set up XTMP global
|
|
N X,X1,X2
|
|
S X1=DT,X2=60 D C^%DTC
|
|
S ^XTMP("BPS01P5B",0)=X_U_DT_U_"BPS Stats Update"
|
|
M ^XTMP("BPS01P5B","STATS")=^BPSECX("S",1)
|
|
;
|
|
; Save off old stats and reset stats
|
|
L +^BPSECX("S",1,"R"):5
|
|
S $P(^BPSECX("S",1,"R"),U,2,8)=$P(RESP1,U,2,8)
|
|
S $P(^BPSECX("S",1,"R"),U,19)=$P(RESP1,U,19)
|
|
L -^BPSECX("S",1,"R")
|
|
Q
|
|
;
|
|
; SUBMIT - Move Submit Date/Time from submit queue to
|
|
; BPS Transaction
|
|
SUBMIT ;
|
|
; Initialize variables
|
|
N RXI,RXR,IEN59,SUBDT
|
|
;
|
|
; Get RX/Fill from submit queue
|
|
S RXI=""
|
|
F S RXI=$O(^XTMP("BPSOSRX",RXI)) Q:RXI="" D
|
|
. S RXR="" F S RXR=$O(^XTMP("BPSOSRX",RXI,RXR)) Q:RXR="" D
|
|
.. ; Calculate IEN59
|
|
.. S IEN59=$$IEN59^BPSOSRX(RXI,RXR)
|
|
.. ; If no IEN59 or zero node not defined, quit
|
|
.. I IEN59="" Q
|
|
.. I '$D(^BPST(IEN59,0)) Q
|
|
.. ; Get submit date and quit if not there
|
|
.. S SUBDT=$G(^XTMP("BPSOSRX",RXI,RXR))
|
|
.. I SUBDT="" Q
|
|
.. ; If not processed yet, quit
|
|
.. I $D(^XTMP("BPS-PROC","CLAIM",RXI,RXR)) Q
|
|
.. I $D(^XTMP("BPS-PROC","UNCLAIM",RXI,RXR)) Q
|
|
.. ; Store in BPS Transaction
|
|
.. S $P(^BPST(IEN59,0),U,7)=SUBDT
|
|
Q
|