BPSOSCE ;BHAM ISC/FCS/DRS/DLF - New entry in 9002313.02 ;06/01/2004
;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,10,11,15,19,24**;JUN 2004;Build 43
;;Per VA Directive 6402, this routine should not be modified.
;
;Create an Electronic Claim Submission record
; the BPS array is shared by all of the BPSOSC* routines
; BPS is created in BPSOSCA
;
Q
;
;NEWCLAIM^BPSOSCE called from BPSOSCA from BPSOSQG from BPSOSQ2
; create /update an entry in BPS CLAIMS (#9002313.02)
; then call the code that populates the entry
; START = START Medication Number
; END = END Medication Number
; TOTAL = TOTAL Medications in Claim
; process from BPS("RX",START) through BPS("RX",END)
NEWCLAIM(START,END,TOTAL) ; function, returns null on success, else error
;
N BPSIEN,CLAIMID,COUNT,DA,DIC,DIK,DLAYGO,ERROR,INDEX,NODE0,ROU,SEG,X,Y
S ROU=$T(+0),START=+$G(START),END=+$G(END),TOTAL=+$G(TOTAL)
;
;Create new record in Claim Submission File (9002313.02)
; try for exclusive access for 1 min. before logging error
F L +^XTMP(ROU,"NEWCLAIM"):60 Q:$T D
.N A S A=$$IMPOSS^BPSOSUE("L","RTI","Single-threaded routine",,,ROU)
; Generate Claim ID
S CLAIMID=$$CLAIMID^BPSECX1($G(BPS("RX",START,"IEN59")))
I CLAIMID="" D
.S ERROR="320^VA Claim ID not created"
.D LOG(ROU_"-Failed to create Claim ID")
;
; Create claim record
D:'$G(ERROR)
.S DLAYGO=9002313.02,DIC="^BPSC(",DIC(0)="LXZ",X=CLAIMID
.D ^DIC Q:Y>0 ; less than zero is error
.S ERROR="321^Failed to create claim record"
.D LOG(ROU_"-Failed to create an entry in file 9002313.02")
;
L -^XTMP(ROU,"NEWCLAIM")
;
Q:$G(ERROR) ERROR
;
; Update BPS and Log it
S BPS(9002313.02)=+Y
; Needed for Turn-Around Stats - Do NOT delete/alter!!
D LOG(ROU_"-Created claim ID "_CLAIMID_" (IEN "_BPS(9002313.02)_")")
;
; Update zero node of the claim
S NODE0=$G(^BPSC(BPS(9002313.02),0))
S $P(NODE0,U,2)=$G(BPS("NCPDP","IEN")) ; Electronic Payor (Payer Sheet)
S $P(NODE0,U,4)=2 ; Transmit Flag - 2 is 'Yes (Point of Sale)'
S $P(NODE0,U,6)=$$NOWFM^BPSOSU1() ; Created On
S ^BPSC(BPS(9002313.02),0)=NODE0
;
; Update Patient Name
S $P(^BPSC(BPS(9002313.02),1),U,1)=$G(BPS("Patient","Name"))
S $P(^BPSC(BPS(9002313.02),1),U,4)=$G(BPS("Insurer","IEN"))
; Update TRANSACTION field
S $P(^BPSC(BPS(9002313.02),0),U,8)=$G(BPS("RX",START,"IEN59"))
;
; Count of meds in claim
S BPS("Transaction Count")=TOTAL
;
; Process the 'non-multiple' segments (Header, Patient, Cardholder)
F SEG=100:10:120 D XLOOP^BPSOSCF(BPS("NCPDP","IEN"),SEG)
;
; zero node for MEDICATIONS SUB-FIELD (#9002313.0201)
S:'$D(^BPSC(BPS(9002313.02),400,0)) ^(0)="^9002313.0201PA^^"
S COUNT=0 F INDEX=START:1:END D
.; Create zero node for entry in multiple
.S COUNT=COUNT+1,NODE0=""
.S $P(NODE0,U)=INDEX,$P(NODE0,U,4)=$G(BPS("RX",INDEX,"Drug Name")),$P(NODE0,U,5)=$G(BPS("RX",INDEX,"RX IEN"))
.S ^BPSC(BPS(9002313.02),400,INDEX,0)=NODE0
.S BPS(9002313.0201)=INDEX
.; Process entries in medication multiple
.F SEG=130:10:300 D XLOOP^BPSOSCF(BPS("NCPDP","IEN"),SEG,INDEX) ; BPS*1*19 - add Intermediary and Last Known 4Rx segments
.; Process entries in "D00" node of the Claim
.; Prescriber DEA Number D01-KV
.S BPSIEN=$O(^BPSF(9002313.91,"C","PRESCRIBER DEA NUMBER",""))
.I BPSIEN'="" D XFLDCODE^BPSOSCF(150,BPSIEN,"GFS") ; calls the GET, FORMAT and SET for NCPDP Field in file 9002313.91
.; Total Prescribed Qty Remaining D02-KW
.S BPSIEN=$O(^BPSF(9002313.91,"C","TOTAL PRESCRIBED QTY REMAINING",""))
.D FLDD02^BPSOSSG
.;
.; Update the indices
.S ^BPSC(BPS(9002313.02),400,"B",INDEX,INDEX)=""
.; Update top-level node of the multiple
.S NODE0=$G(^BPSC(BPS(9002313.02),400,0))
.S $P(NODE0,U,3)=COUNT,$P(NODE0,U,4)=COUNT,^BPSC(BPS(9002313.02),400,0)=NODE0
;
; Cross-Reference Claim Submission Record
S DIK="^BPSC(",DA=BPS(9002313.02) D IX1^DIK
;
Q "" ; Return null on success
;
LOG(MSG) ;log the message for all the transactions in this 9002313.02 claim
N I,IEN59
F I=START:1:END S IEN59=$G(BPS("RX",I,"IEN59")) D:IEN59 LOG^BPSOSL(IEN59,MSG)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOSCE 4107 printed Nov 22, 2024@17:01:50 Page 2
BPSOSCE ;BHAM ISC/FCS/DRS/DLF - New entry in 9002313.02 ;06/01/2004
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,10,11,15,19,24**;JUN 2004;Build 43
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;Create an Electronic Claim Submission record
+5 ; the BPS array is shared by all of the BPSOSC* routines
+6 ; BPS is created in BPSOSCA
+7 ;
+8 QUIT
+9 ;
+10 ;NEWCLAIM^BPSOSCE called from BPSOSCA from BPSOSQG from BPSOSQ2
+11 ; create /update an entry in BPS CLAIMS (#9002313.02)
+12 ; then call the code that populates the entry
+13 ; START = START Medication Number
+14 ; END = END Medication Number
+15 ; TOTAL = TOTAL Medications in Claim
+16 ; process from BPS("RX",START) through BPS("RX",END)
NEWCLAIM(START,END,TOTAL) ; function, returns null on success, else error
+1 ;
+2 NEW BPSIEN,CLAIMID,COUNT,DA,DIC,DIK,DLAYGO,ERROR,INDEX,NODE0,ROU,SEG,X,Y
+3 SET ROU=$TEXT(+0)
SET START=+$GET(START)
SET END=+$GET(END)
SET TOTAL=+$GET(TOTAL)
+4 ;
+5 ;Create new record in Claim Submission File (9002313.02)
+6 ; try for exclusive access for 1 min. before logging error
+7 FOR
LOCK +^XTMP(ROU,"NEWCLAIM"):60
if $TEST
QUIT
Begin DoDot:1
+8 NEW A
SET A=$$IMPOSS^BPSOSUE("L","RTI","Single-threaded routine",,,ROU)
End DoDot:1
+9 ; Generate Claim ID
+10 SET CLAIMID=$$CLAIMID^BPSECX1($GET(BPS("RX",START,"IEN59")))
+11 IF CLAIMID=""
Begin DoDot:1
+12 SET ERROR="320^VA Claim ID not created"
+13 DO LOG(ROU_"-Failed to create Claim ID")
End DoDot:1
+14 ;
+15 ; Create claim record
+16 if '$GET(ERROR)
Begin DoDot:1
+17 SET DLAYGO=9002313.02
SET DIC="^BPSC("
SET DIC(0)="LXZ"
SET X=CLAIMID
+18 ; less than zero is error
DO ^DIC
if Y>0
QUIT
+19 SET ERROR="321^Failed to create claim record"
+20 DO LOG(ROU_"-Failed to create an entry in file 9002313.02")
End DoDot:1
+21 ;
+22 LOCK -^XTMP(ROU,"NEWCLAIM")
+23 ;
+24 if $GET(ERROR)
QUIT ERROR
+25 ;
+26 ; Update BPS and Log it
+27 SET BPS(9002313.02)=+Y
+28 ; Needed for Turn-Around Stats - Do NOT delete/alter!!
+29 DO LOG(ROU_"-Created claim ID "_CLAIMID_" (IEN "_BPS(9002313.02)_")")
+30 ;
+31 ; Update zero node of the claim
+32 SET NODE0=$GET(^BPSC(BPS(9002313.02),0))
+33 ; Electronic Payor (Payer Sheet)
SET $PIECE(NODE0,U,2)=$GET(BPS("NCPDP","IEN"))
+34 ; Transmit Flag - 2 is 'Yes (Point of Sale)'
SET $PIECE(NODE0,U,4)=2
+35 ; Created On
SET $PIECE(NODE0,U,6)=$$NOWFM^BPSOSU1()
+36 SET ^BPSC(BPS(9002313.02),0)=NODE0
+37 ;
+38 ; Update Patient Name
+39 SET $PIECE(^BPSC(BPS(9002313.02),1),U,1)=$GET(BPS("Patient","Name"))
+40 SET $PIECE(^BPSC(BPS(9002313.02),1),U,4)=$GET(BPS("Insurer","IEN"))
+41 ; Update TRANSACTION field
+42 SET $PIECE(^BPSC(BPS(9002313.02),0),U,8)=$GET(BPS("RX",START,"IEN59"))
+43 ;
+44 ; Count of meds in claim
+45 SET BPS("Transaction Count")=TOTAL
+46 ;
+47 ; Process the 'non-multiple' segments (Header, Patient, Cardholder)
+48 FOR SEG=100:10:120
DO XLOOP^BPSOSCF(BPS("NCPDP","IEN"),SEG)
+49 ;
+50 ; zero node for MEDICATIONS SUB-FIELD (#9002313.0201)
+51 if '$DATA(^BPSC(BPS(9002313.02),400,0))
SET ^(0)="^9002313.0201PA^^"
+52 SET COUNT=0
FOR INDEX=START:1:END
Begin DoDot:1
+53 ; Create zero node for entry in multiple
+54 SET COUNT=COUNT+1
SET NODE0=""
+55 SET $PIECE(NODE0,U)=INDEX
SET $PIECE(NODE0,U,4)=$GET(BPS("RX",INDEX,"Drug Name"))
SET $PIECE(NODE0,U,5)=$GET(BPS("RX",INDEX,"RX IEN"))
+56 SET ^BPSC(BPS(9002313.02),400,INDEX,0)=NODE0
+57 SET BPS(9002313.0201)=INDEX
+58 ; Process entries in medication multiple
+59 ; BPS*1*19 - add Intermediary and Last Known 4Rx segments
FOR SEG=130:10:300
DO XLOOP^BPSOSCF(BPS("NCPDP","IEN"),SEG,INDEX)
+60 ; Process entries in "D00" node of the Claim
+61 ; Prescriber DEA Number D01-KV
+62 SET BPSIEN=$ORDER(^BPSF(9002313.91,"C","PRESCRIBER DEA NUMBER",""))
+63 ; calls the GET, FORMAT and SET for NCPDP Field in file 9002313.91
IF BPSIEN'=""
DO XFLDCODE^BPSOSCF(150,BPSIEN,"GFS")
+64 ; Total Prescribed Qty Remaining D02-KW
+65 SET BPSIEN=$ORDER(^BPSF(9002313.91,"C","TOTAL PRESCRIBED QTY REMAINING",""))
+66 DO FLDD02^BPSOSSG
+67 ;
+68 ; Update the indices
+69 SET ^BPSC(BPS(9002313.02),400,"B",INDEX,INDEX)=""
+70 ; Update top-level node of the multiple
+71 SET NODE0=$GET(^BPSC(BPS(9002313.02),400,0))
+72 SET $PIECE(NODE0,U,3)=COUNT
SET $PIECE(NODE0,U,4)=COUNT
SET ^BPSC(BPS(9002313.02),400,0)=NODE0
End DoDot:1
+73 ;
+74 ; Cross-Reference Claim Submission Record
+75 SET DIK="^BPSC("
SET DA=BPS(9002313.02)
DO IX1^DIK
+76 ;
+77 ; Return null on success
QUIT ""
+78 ;
LOG(MSG) ;log the message for all the transactions in this 9002313.02 claim
+1 NEW I,IEN59
+2 FOR I=START:1:END
SET IEN59=$GET(BPS("RX",I,"IEN59"))
if IEN59
DO LOG^BPSOSL(IEN59,MSG)
+3 QUIT
+4 ;
