BPSJUTL1 ;BHAM ISC/DB - e-Pharmacy Utils ;18-JAN-2004
;;1.0;E CLAIMS MGMT ENGINE;**1**;JUN 2004
;;Per VHA Directive 10-93-142, this routine should not be modified.
; Special Code for WebMD Test
; WBTESTB1 - Billing
; WBTESTB2 - Reversal
; Tags are 'FLD'_<Field_Number>_<'B' (billing) or 'R' (reversal)>
FLD402B ;
S BPS("X")=$G(BPS("X")) I $G(BPS(9002313.0201))="" Q
I BPS("RX",BPS(9002313.0201),"RX IEN")=401944 S BPS("X")=7
I BPS("RX",BPS(9002313.0201),"RX IEN")=401959 S BPS("X")=1
I BPS("RX",BPS(9002313.0201),"RX IEN")=401974 S BPS("X")=2
I BPS("RX",BPS(9002313.0201),"RX IEN")=401976 S BPS("X")=3
I BPS("RX",BPS(9002313.0201),"RX IEN")=401958 S BPS("X")=4
;???
I BPS("X")="" S BPS("X")=BPS("RX",BPS(9002313.0201),"RX IEN")
I BPS("RX",BPS(9002313.0201),"RX IEN")'=401944 S BPS("X")=BPS("RX",BPS(9002313.0201),"RX IEN")
Q
;
FLD408B ;
S BPS("X")=0 I $G(BPS(9002313.0201))="" Q
I BPS("RX",BPS(9002313.0201),"RX IEN")=401944 S BPS("X")="1"
I BPS("RX",BPS(9002313.0201),"RX IEN")=401959 S BPS("X")="1"
I BPS("RX",BPS(9002313.0201),"RX IEN")=401974 S BPS("X")="1"
I BPS("RX",BPS(9002313.0201),"RX IEN")=401976 S BPS("X")="0"
I BPS("RX",BPS(9002313.0201),"RX IEN")=401958 S BPS("X")="1"
Q
;
FLD419B ;
S BPS("X")=0 I $G(BPS(9002313.0201))="" Q
I BPS("RX",BPS(9002313.0201),"RX IEN")=401944 S BPS("X")="1"
I BPS("RX",BPS(9002313.0201),"RX IEN")=401959 S BPS("X")="1"
I BPS("RX",BPS(9002313.0201),"RX IEN")=401974 S BPS("X")="2"
I BPS("RX",BPS(9002313.0201),"RX IEN")=401976 S BPS("X")="1"
I BPS("RX",BPS(9002313.0201),"RX IEN")=401958 S BPS("X")="1"
Q
;
FLD420B ;
S BPS("X")="00" I $G(BPS(9002313.0201))="" Q
I BPS("RX",BPS(9002313.0201),"RX IEN")=401944 S BPS("X")="03"
I BPS("RX",BPS(9002313.0201),"RX IEN")=401959 S BPS("X")="00"
I BPS("RX",BPS(9002313.0201),"RX IEN")=401974 S BPS("X")="04"
I BPS("RX",BPS(9002313.0201),"RX IEN")=401976 S BPS("X")="03"
I BPS("RX",BPS(9002313.0201),"RX IEN")=401958 S BPS("X")="00"
Q
;
FLD433B ;
S BPS("X")=10.0 I $G(BPS(9002313.0201))="" Q
I BPS("RX",BPS(9002313.0201),"RX IEN")=401974 S BPS("X")=5.0
I BPS("RX",BPS(9002313.0201),"RX IEN")=401976 S BPS("X")=5.0
I BPS("RX",BPS(9002313.0201),"RX IEN")=401958 S BPS("X")=5.0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSJUTL1 2256 printed Dec 13, 2024@01:51:05 Page 2
BPSJUTL1 ;BHAM ISC/DB - e-Pharmacy Utils ;18-JAN-2004
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1**;JUN 2004
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ; Special Code for WebMD Test
+4 ; WBTESTB1 - Billing
+5 ; WBTESTB2 - Reversal
+6 ; Tags are 'FLD'_<Field_Number>_<'B' (billing) or 'R' (reversal)>
FLD402B ;
+1 SET BPS("X")=$GET(BPS("X"))
IF $GET(BPS(9002313.0201))=""
QUIT
+2 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401944
SET BPS("X")=7
+3 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401959
SET BPS("X")=1
+4 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401974
SET BPS("X")=2
+5 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401976
SET BPS("X")=3
+6 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401958
SET BPS("X")=4
+7 ;???
+8 IF BPS("X")=""
SET BPS("X")=BPS("RX",BPS(9002313.0201),"RX IEN")
+9 IF BPS("RX",BPS(9002313.0201),"RX IEN")'=401944
SET BPS("X")=BPS("RX",BPS(9002313.0201),"RX IEN")
+10 QUIT
+11 ;
FLD408B ;
+1 SET BPS("X")=0
IF $GET(BPS(9002313.0201))=""
QUIT
+2 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401944
SET BPS("X")="1"
+3 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401959
SET BPS("X")="1"
+4 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401974
SET BPS("X")="1"
+5 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401976
SET BPS("X")="0"
+6 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401958
SET BPS("X")="1"
+7 QUIT
+8 ;
FLD419B ;
+1 SET BPS("X")=0
IF $GET(BPS(9002313.0201))=""
QUIT
+2 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401944
SET BPS("X")="1"
+3 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401959
SET BPS("X")="1"
+4 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401974
SET BPS("X")="2"
+5 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401976
SET BPS("X")="1"
+6 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401958
SET BPS("X")="1"
+7 QUIT
+8 ;
FLD420B ;
+1 SET BPS("X")="00"
IF $GET(BPS(9002313.0201))=""
QUIT
+2 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401944
SET BPS("X")="03"
+3 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401959
SET BPS("X")="00"
+4 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401974
SET BPS("X")="04"
+5 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401976
SET BPS("X")="03"
+6 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401958
SET BPS("X")="00"
+7 QUIT
+8 ;
FLD433B ;
+1 SET BPS("X")=10.0
IF $GET(BPS(9002313.0201))=""
QUIT
+2 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401974
SET BPS("X")=5.0
+3 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401976
SET BPS("X")=5.0
+4 IF BPS("RX",BPS(9002313.0201),"RX IEN")=401958
SET BPS("X")=5.0
+5 QUIT
