- BPSOS ;BHAM ISC/FCS/DRS - Table of Contents, etc ;06/01/2004
- ;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- Q
- ;
- TOC N I,X F I=0:1 S X=$P($T(TOC1+I),";",2,9) Q:X="*" D
- . W X,!
- Q
- TOC1 ; Directory of BPSEC* and BPSOS*
- ; BPSECA* - Build formatted claim packets
- ; BPSECFM - Formatting (signed numeric overpunch, etc.)
- ; BPSECM* - Parse Response packets
- ; BPSECX* - Low-level BPS Claims routines, descendant from BPSOSQ2
- ; BPSMHDR - Menu header
- ; BPSNCP* - Callable API to initiate an ECME claim
- ; BPSOS0* - Some fetch utilities for BPS Claims and BPS Responses
- ; BPSOS2x - Statistics Screen
- ; BPSOS57 - Utilities for BPS Log of Transactions
- ; BPSOS6M - Developer Log
- ; BPSOSC2 - Certification utilities (sporadic development use only)
- ; BPSOSCx - Building BPS Claims (BPSOSQ2->QG->CA->C*)
- ; BPSOSH* - Support utilities for packet building
- ; BPSOSI* - BPS Transaction creation
- ; BPSOSK* - Winnowing old data
- ; BPSOSL* - Log file utilities
- ; BPSOSO* - Override NCPDP Data Dictionary values
- ; BPSOSQ* - Claim processing through the queues
- ; BPSOSR* - Queue Processing
- ; BPSOSS* - Setup POS
- ; BPSOSU* - Utilities
- ;*
- RXDEL(RXI,RXR) ; EP - $$ is RX deleted?
- ; For refills: if the refill multiple is gone, it's been "deleted"
- I $G(RXR),$$RXSUBF1^BPSUTIL1(RXI,52,52.1,RXR,.01,"I")="" Q 1
- ; For first fill: look at the STATUS flag
- I $$RXAPI1^BPSUTIL1(RXI,.01,"E")="" Q 1 ; shouldn't be missing but is
- N X S X=$$RXAPI1^BPSUTIL1(RXI,100,"I")
- Q X=13 ; if status is DELETED
- ZWRITE(%,VARA,VARB,VARC,VARD,VARE) ;EP - from many, many places
- I %="%"!(%?1"VAR"1U) D Q
- . D IMPOSS^BPSOSUE("P","TI","Conflict in var names",%,"ZWRITE",$T(+0))
- I '$D(@%) W %," is undefined",! Q
- I $D(@%)#10 W %,"=",@%,!
- F S %=$Q(@%) Q:%="" W %,"=",@%,!
- I $D(VARA) D ZWRITE(VARA)
- I $D(VARB) D ZWRITE(VARB)
- I $D(VARC) D ZWRITE(VARC)
- I $D(VARD) D ZWRITE(VARD)
- I $D(VARE) D ZWRITE(VARE)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOS 2017 printed Jan 18, 2025@02:52:39 Page 2
- BPSOS ;BHAM ISC/FCS/DRS - Table of Contents, etc ;06/01/2004
- +1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 QUIT
- +5 ;
- TOC NEW I,X
- FOR I=0:1
- SET X=$PIECE($TEXT(TOC1+I),";",2,9)
- if X="*"
- QUIT
- Begin DoDot:1
- +1 WRITE X,!
- End DoDot:1
- +2 QUIT
- TOC1 ; Directory of BPSEC* and BPSOS*
- +1 ; BPSECA* - Build formatted claim packets
- +2 ; BPSECFM - Formatting (signed numeric overpunch, etc.)
- +3 ; BPSECM* - Parse Response packets
- +4 ; BPSECX* - Low-level BPS Claims routines, descendant from BPSOSQ2
- +5 ; BPSMHDR - Menu header
- +6 ; BPSNCP* - Callable API to initiate an ECME claim
- +7 ; BPSOS0* - Some fetch utilities for BPS Claims and BPS Responses
- +8 ; BPSOS2x - Statistics Screen
- +9 ; BPSOS57 - Utilities for BPS Log of Transactions
- +10 ; BPSOS6M - Developer Log
- +11 ; BPSOSC2 - Certification utilities (sporadic development use only)
- +12 ; BPSOSCx - Building BPS Claims (BPSOSQ2->QG->CA->C*)
- +13 ; BPSOSH* - Support utilities for packet building
- +14 ; BPSOSI* - BPS Transaction creation
- +15 ; BPSOSK* - Winnowing old data
- +16 ; BPSOSL* - Log file utilities
- +17 ; BPSOSO* - Override NCPDP Data Dictionary values
- +18 ; BPSOSQ* - Claim processing through the queues
- +19 ; BPSOSR* - Queue Processing
- +20 ; BPSOSS* - Setup POS
- +21 ; BPSOSU* - Utilities
- +22 ;*
- RXDEL(RXI,RXR) ; EP - $$ is RX deleted?
- +1 ; For refills: if the refill multiple is gone, it's been "deleted"
- +2 IF $GET(RXR)
- IF $$RXSUBF1^BPSUTIL1(RXI,52,52.1,RXR,.01,"I")=""
- QUIT 1
- +3 ; For first fill: look at the STATUS flag
- +4 ; shouldn't be missing but is
- IF $$RXAPI1^BPSUTIL1(RXI,.01,"E")=""
- QUIT 1
- +5 NEW X
- SET X=$$RXAPI1^BPSUTIL1(RXI,100,"I")
- +6 ; if status is DELETED
- QUIT X=13
- ZWRITE(%,VARA,VARB,VARC,VARD,VARE) ;EP - from many, many places
- +1 IF %="%"!(%?1"VAR"1U)
- Begin DoDot:1
- +2 DO IMPOSS^BPSOSUE("P","TI","Conflict in var names",%,"ZWRITE",$TEXT(+0))
- End DoDot:1
- QUIT
- +3 IF '$DATA(@%)
- WRITE %," is undefined",!
- QUIT
- +4 IF $DATA(@%)#10
- WRITE %,"=",@%,!
- +5 FOR
- SET %=$QUERY(@%)
- if %=""
- QUIT
- WRITE %,"=",@%,!
- +6 IF $DATA(VARA)
- DO ZWRITE(VARA)
- +7 IF $DATA(VARB)
- DO ZWRITE(VARB)
- +8 IF $DATA(VARC)
- DO ZWRITE(VARC)
- +9 IF $DATA(VARD)
- DO ZWRITE(VARD)
- +10 IF $DATA(VARE)
- DO ZWRITE(VARE)
- +11 QUIT