25. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 9/19/2018 12:35:41 PM Central Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.

25.1 Files compared

# Location File Last Modified
1 ePharmacy_Bundle 12.zip TAS+ePhm+SDD+US2601_v1.02.docx Wed Sep 12 15:17:00 2018 UTC
2 ePharmacy_Bundle 12.zip TAS+ePhm+SDD+US2601_v1.02.docx Wed Sep 19 14:57:57 2018 UTC

25.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 1 3226
Changed 0 0
Inserted 0 0
Removed 0 0

25.3 Comparison options

Whitespace
Character case Differences in character case are significant
Line endings Differences in line endings (CR and LF characters) are ignored
CR/LF characters Not shown in the comparison detail

25.4 Active regular expressions

No regular expressions were active.

25.5 Comparison detail

  1   MCCF EDI T AS 
  2   US2601/US2 603/US2604 /US2607/US 2608
  3   System Des ign Docume nt
  4  
  5  
  6  
  7  
  8  
  9   Department  of Vetera ns Affairs
  10   March 2018
  11   Version 1. 02
  12   User Story  Number: 
  13   User Story  Name: Imp rove Exist ing Pharma cy Report:   Payable  Claims Rep ort; Rever sal Claims  Report; C laims Subm itted, Not  Yet Relea sed; Close d Claims R eport; Non -Billable  Status  
  14   Product Ba cklog ID: 
  15   Priority:  30.1/ 30.2 / 30.4/ 30 .3/ 30.5
  16   Initial Si zing Estim ate: 
  17   Rational I D: 
  18   Rally ID:  US2601/ US 2603/ US26 04/ US2607 / US2608
  19   Epic Taxon omy: Updat e
  20  
  21   Design – S ummary
  22   The ePharm acy users  need to be  able to s elect one,  multiple  or all for  each filt er questio n when run ning the f ollowing r eports:
  23   Payable Cl aims Repor t
  24   Reversal C laims Repo rt
  25   Claims Sub mitted, No t Yet Rele ased
  26   Closed Cla ims Report
  27   Non-Billab le Status  Report
  28   Several ne w filters  will be ad ded which  will resul t in addit ional data  displayin g on the h eadings an d bodies o f these re ports.
  29  
  30   List of Co mponents:
  31   Routine: B PSRPT0
  32   Routine: B PSRPT1
  33   Routine: B PSRPT3
  34   Routine: B PSRPT3A
  35   Routine: B PSRPT4
  36   Routine: B PSRPT5
  37   Routine: B PSRPT7
  38   Routine: B PSRPT8
  39   Routine: B PSSCRCU
  40   Routine: I BNCPEV3
  41  
  42   Design – D etail
  43   This user  story pert ains to th e changes  being made  to the Pa yable Clai ms Report;  Reversal  Claims Rep ort; Claim s Submitte d, Not Yet  Released;  Closed Cl aims and N on-Billabl e Status R eport.  Th e changes  being made  to these  reports ar e as follo ws:
  44  
  45   allow the  user to ma ke multipl e selectio ns
  46   add new fi lter quest ions
  47   reword the  Excel cap ture instr uctions
  48   modify rep ort header
  49   modify exc el header  and report  data
  50  
  51   Throughout  the ^BPSR PT* routin es, the va riable BPR TYPE indic ates which  report th e user is  printing.
  52   1 – Payabl e Claims R eport
  53   2 – Reject ed Claims  Report
  54   3 – Claims  Submitted , Not Yet  Released
  55   4 – Revers al Claims  Report
  56   5 – Recent  Transacti ons
  57   6 – Totals  by Date
  58   7 – Closed  Claims Re port
  59   8 – Spendi ng Account  Report
  60   9 – Non-Bi llable Sta tus Report
  61  
  62   The table  below indi cates whic h filter p rompts are  available  for each  report by  BPRTYPE an d whether  the report  allows th e user to  select onl y one or m ultiple re sponses.
  63  
  64   Filter Pro mpt 
  65   Single res ponse
  66   Multiple r esponses
  67   CMOP, Mail  or Window  
  68   5, 6, 8
  69   1, 2, 3, 4 , 7, 9
  70   Real Time  Fills, Bac kbill, PRO  Option or  Resubmiss ion
  71   5, 6, 8
  72   1, 2, 3, 4 , 7, 9
  73   Drug
  74   5, 6, 8
  75   1, 2, 3, 4 , 7, 9
  76   Drug Class
  77   5, 6, 8
  78   1, 2, 3, 4 , 7, 9
  79   Close Clai m Reason
  80   -
  81   7
  82   Eligibilit y
  83   -
  84   1, 2, 3, 4 , 7, 9
  85   Patient
  86   -
  87   1, 2, 3, 4 , 7, 9
  88   Billed Amo unt
  89   -
  90   1, 2, 3, 4 , 9
  91  
  92  
  93   The change s to allow  the user  to make mu ltiple sel ections an d the new  filter que stions for  the Payab le Claims  Report; Re versal Cla ims Report ; Claims S ubmitted,  Not Yet; a nd Closed  Claims Rep ort are de scribed be low.  
  94  
  95   If a user  selects to  enter a s pecific Di vision, In surance, D rug, Drug  Class or P atient and  then hits  enter wit hout provi ding a sel ection the y should b e go back  to the ori ginal prom pt.  BPSRP T0, BPSRPT 3 and BPSR PT3A were  modified t o handle t his functi onality.
  96  
  97   Subroutine  Name
  98   EN^BPSRPT0
  99   Enhancemen t Category
  100    New
  101    Modify
  102    Delete
  103    No Change
  104   Current Lo gic
  105  
  106   BPSRPT0 ;B HAM ISC/BE E - ECME R EPORTS ;14 -FEB-05
  107    ;;1.0;E C LAIMS MGMT  ENGINE;** 1,5,7,10,1 1,19,20,23 **;JUN 200 4;Build 27
  108    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  109    ;
  110   . . .
  111                               
  112   EN(BPRTYPE ) N %,BPAC REJ,BPAUTR EV,BPBEGDT ,BPCCRSN,B PDRGCL,BPD RUG,BPENDD T,BPEXCEL, BPNOW,BPPH ARM,BPINSI NF,BPMWC,B PQ,BPQSTDR G N BPREJC D,BPRLNRL, BPRPTNAM,B PRTBCK,BPS CR,BPSUMDE T,CODE,POS ,STAT,X,Y, BPINS,BPAR R,BPELIG,B POPCL N BP NBSTS,BPAL RC,BPELIG1 ,BPRESC,BP PAT,BPQSTP AT,BPBILL, BPMIN,BPMA X,BPSLC,BP SUC ; ;Ver ify that a  valid rep ort has be en request ed I ",1,2 ,3,4,5,6,7 ,8,9,"'[(" ,"_$G(BPRT YPE)_",")  W "<Invali d Menu Def inition -  Report Und efined>" H  3 Q S BPR PTNAM=$P(" PAYABLE CL AIMS^REJEC TED CLAIMS ^SUBMIT,NO T RELEASED  CLAIMS^RE VERSED CLA IMS^RECENT  TRANSACTI ONS^TOTALS ^CLOSED CL AIMS^SPEND ING ACCOUN T REPORT^R XS WITH NO N-BILLABLE  STATUS"," ^",BPRTYPE ) ; ;Neede d to conve rt lower c ase entrie s to upper  case S BP SLC="abcde fghijklmno pqrstuvwxy z" S BPSUC ="ABCDEFGH IJKLMNOPQR STUVWXYZ"  ; ;Get cur rent Date/ Time D NOW ^%DTC S Y= % D DD^%DT  S BPNOW=Y  ; ;Prompt  for ECME  Pharmacy D ivision(s)  (No Defau lt) ;Sets  up BPPHARM  variable  and array,  BPPHARM = 0 ALL or B PPHARM=1,B PPHARM(ptr ) for list  S X=$$SEL PHARM^BPSR PT3() I X= "^" G EXIT  ; ;Prompt  to Displa y Summary  or Detail  Format (De fault to D etail) ;Re turns 1 fo r Summary,  0 for Det ail S BPSU MDET=$$SEL SMDET^BPSR PT3(2) I B PSUMDET="^ " G EXIT ;  ;Prompt t o allow se lection of  Multiple  Insurances  or All (D efault to  ALL) ;See  descriptio n for $$IN SURSEL^BPS SCRCU S BP INS=$$INSU RSEL^BPSSC RCU(.BPARR ,DUZ) I BP INS<1 G EX IT S BPINS INF=$S(BPA RR(1.11)=" I":BPARR(" INS"),1:0)  ;If Multi ple Insura nces was s elected "I " and the  the user e ntered "^"  or ;the u ser hit re turn there fore not s electing a  Insurance  return to  the menu  I BPINSINF =";" G EXI T ; ;Promp t to Displ ay (C)MOP  or (M)ail  or (W)indo w or (A)LL  (Default  to ALL) ;R eturns (A- ALL,M-Mail ,W-Window, C-CMOP) I  (",2,")'[B PRTYPE S B PMWC=$$SEL MWC^BPSRPT 3("A") I B PMWC="^" G  EXIT I (" ,2,")[BPRT YPE S BPMW C=$$SELMWC 1^BPSRPT3( "A") I BPM WC="^" G E XIT ; ;Pro mpt to Dis play (R)ea lTime Fill s or (B)ac kbills or  (P)RO Opti on or Re(S )ubmission  or (A)LL  (Default t o ALL) ;Re turns (1-A LL,2-RealT ime Fills, 3-Backbill s,4-PRO Op tion,5-Res ubmission)  S BPRTBCK =1 I (",2, 9,")'[BPRT YPE S BPRT BCK=$$SELR TBCK^BPSRP T3(1) I BP RTBCK="^"  G EXIT I ( ",2,9,")[B PRTYPE S B PRTBCK=$$S ELRBPS^BPS RPT3() I B PRTBCK="^"  G EXIT ;  ;Prompt to  Display S pecific (D )rug or Dr ug (C)lass  or (A)ll  (Default t o ALL) ;Re turns (1-A LL,2-Drug, 3-Drug Cla ss) S BPQS TDRG=$$SEL DRGAL^BPSR PT3(1) I B PQSTDRG="^ " Q ; ;Pro mpt to Sel ect Drug ( No Default ) S BPDRUG =0 I BPQST DRG=2 D  I  BPDRUG="^ " G EXIT .  I (",2,") '[BPRTYPE  S BPDRUG=$ $SELDRG^BP SRPT3() .  I (",2,")[ BPRTYPE S  BPDRUG=$$S ELDRG1^BPS RPT3A() ;  ;Prompt to  Select Dr ug Class ( No Default ) S BPDRGC L=0 I BPQS TDRG=3 D   I BPDRGCL= "^" G EXIT  . I (",2, ")'[BPRTYP E S BPDRGC L=$$SELDRG CL^BPSRPT3 () . I (", 2,")[BPRTY PE S BPDRG CL=$$SELDC ^BPSRPT3A( ) ; ;Repor t Specific  Prompts ;  ;Prompt t o select D ate Range  ;Returns ( Start Date ^End Date)  I (",1,2, 3,4,5,6,7, 8,9,")[BPR TYPE S BPB EGDT=$$SEL DATE^BPSRP T3(BPRTYPE ) D  I BPB EGDT="^" G  EXIT .I B PBEGDT="^"  Q .S BPEN DDT=$P(BPB EGDT,U,2)  .S BPBEGDT =$P(BPBEGD T,U) ; ;Pr ompt to In clude (R)E LEASED or  (N)OT RELE ASED or (A )LL (Defau lt to RELE ASED) ;Ret urns (1-AL L,2-RELEAS ED,3-NOT R ELEASED) S  BPRLNRL=$ S(BPRTYPE= 3:3,1:1) I  (",1,2,4, 6,7,8,9,") [BPRTYPE S  BPRLNRL=$ $SELRLNRL^ BPSRPT4($S (BPRTYPE=9 :1,1:2)) I  BPRLNRL=" ^" G EXIT  ; ;Prompt  to Include  (S)pecifi c Reject C ode or (A) LL (Defaul t to ALL)  ;Returns:  0=ALL ; ^= if user en tered "^"  ; ptr=stri ng of ptr' s delimite d with a c omma e.g.  BPREJCD="9 5,100," ;  (ptr is th e Pointer  to the Sel ected Reje ct Code in  #9002313. 93) S BPRE JCD=0 I (" ,2,")[BPRT YPE S BPRE JCD=$$SELR EJCD^BPSRP T4() I BPR EJCD="^" G  EXIT ; ;P rompt to I nclude Aut o(R)everse d or (A)LL  (Default  to ALL) ;R eturns (0- All,1-Auto Reversed)  S BPAUTREV =0 I (",4, ")[BPRTYPE  S BPAUTRE V=$$SELAUR EV^BPSRPT4 (0) I BPAU TREV="^" G  EXIT ; ;P rompt to I nclude A(C )cepted or  (R)ejecte d or (A)LL  (Default  to REJECTE D) ;Return s (0-All,1 -Rejected, 2-Accepted ) S BPACRE J=0 I (",4 ,")[BPRTYP E S BPACRE J=$$SELACR EJ^BPSRPT4 (1) I BPAC REJ="^" G  EXIT ; ;Pr ompt to In clude (S)p ecific Clo se Claim R eason or ( A)ll (Defa ult to All ) ;Returns  (0-All,pt r-Pointer  to #356.8)  S BPCCRSN =0 I (",7, ")[BPRTYPE  S BPCCRSN =$$SELCCRS N^BPSRPT4( 0) I BPCCR SN="^" G E XIT ; ;Pro mpt for El igibility  Indicator  for payabl e, rejecte d, reverse d and clos ed claims  report ;Re turns (V=V ETERAN,T=T RICARE,C=C HAMPVA,0=A ll) S BPEL IG=0 I (", 1,4,7,")[B PRTYPE S B PELIG=$$SE LELIG^BPSR PT3(1) I B PELIG="^"  G EXIT ; ; Prompt for  All or Mo st Recent  (Non-Billa ble Status  Report on ly) ;Retur ns A - All , R - Most  Recent S  BPALRC=0 I  (",9,")[B PRTYPE S B PALRC=$$SE LALRC^BPSR PT3() I BP ALRC="^" G  EXIT ; ;P rompt for  multiple E ligibility  Indicator  for Non-B illable St atus and R ejected Cl aims Repor t ;Sets up  BPELIG1 v ariable, r eturns 0 i f (A)ll wa s selected  or 1. If  BPELIG1=1  then the a rray ; BPA RR("ELIG")  is set, B PARR("ELIG ",xx) for  each eligi bility sel ected - xx ="V", "T"  or "C" S B PELIG1=0 I  (",2,9,") [BPRTYPE S  BPELIG1=$ $SELELIG1^ BPSRPT3()  I BPELIG1= "^" G EXIT  ; ;Prompt  for Open/ Closed/All  claims ;R eturns (1= Closed,2=O pen,0=All)  S BPOPCL= 0 I (",2," )[BPRTYPE  S BPOPCL=$ $SELOPCL^B PSRPT3(2)  I BPOPCL=" ^" G EXIT  ; ;Prompt  to select  SPECIFIC P RESCRIBER( S) or (A)l l Prescrib ers ;Retur ns: 0=ALL, ^=exit ;if
  113    Specific  Prescriber  was selec ted ;Retur ns: BPRESC =a string  of prescri ber ien's  separated  by a comma  S BPRESC= 0 I (",2," )[BPRTYPE  S BPRESC=$ $SELPRESC^ BPSRPT3A()  I BPRESC= "^" G EXIT  ;  ;Promp t to selec t (P)atien ts or (A)L L Patients  ;Returns:  (0=ALL,1= Patient,^= exit) S BP QSTPAT=0 I  (",2,")[B PRTYPE S B PQSTPAT=$$ SELPA^BPSR PT3A() I B PQSTPAT="^ " G EXIT ;  ;If (P)at ients was  selected,  prompt for  one or mo re patient s ;Returns : BPPAT=a  string of  patient ie n's separa ted by a c omma I BPQ STPAT=1 S  BPPAT=$$SE LPAT^BPSRP T3A() I BP PAT="^" G  EXIT ; ;Pr ompt to se lect(R)ang e for Bill ed Amount  or (A)LL ; Returns: ( 0=ALL,1=Ra nge,^=exit ) S BPBILL =0 I (",2, ")[BPRTYPE  S BPBILL= $$SELBAMT^ BPSRPT3A()  I BPBILL= "^" G EXIT  ;If Range  of Billed  Amount wa s selected  prompt fo r Minimum  and Maximu m ;Returns : BPMIN=mi nimum amou nt entered , BPMAX=ma ximum amou nt entered  S (BPMIN, BPMAX)=0 I  BPBILL=1  W !,"Range  for Bille d Amount"  D  I (BPMI N="^")!(BP MAX="^") G  EXIT . S  BPMIN=$$SE LBMIN^BPSR PT3A() I B PMIN="^" Q  . S BPMAX =$$SELBMAX ^BPSRPT3A( ) ; ;Promp t for Non- Billable S tatus (Non -Billable  Status Rep ort only)  ;Sets up B PNBSTS var iable and  array, BPN BSTS=0 ALL  or BPNBST S=1,BPNBST S(xx) for  list S BPN BSTS=0 I ( ",9,")[BPR TYPE S BPN BSTS=$$SEL NBSTS^BPSR PT3() I BP NBSTS="^"  G EXIT ; ; Prompt for  Excel Cap ture (Deta il Only) S  BPEXCEL=0  I 'BPSUMD ET S BPEXC EL=$$SELEX CEL^BPSRPT 4() I BPEX CEL="^" G  EXIT ; ;Pr ompt for t he Device  I 'BPEXCEL  D .W !!," WARNING -  THIS REPOR T REQUIRES  THAT A DE VICE WITH  132 COLUMN  WIDTH BE  USED." .W  !,"IT WILL  NOT DISPL AY CORRECT LY USING 8 0 COLUMN W IDTH DEVIC ES",! S BP Q=0 D DEVI CE(BPRPTNA M) Q:BPQ ;  ;Compile  and Run th e Report D  RUN(BPEXC EL,BPRPTNA M,BPSUMDET ) I 'BPQ D  PAUSE2^BP SRPT1 ;EXI T Q
  114  
  115   Modified L ogic (Chan ges are hi ghlighted)
  116  
  117   BPSRPT0 ;B HAM ISC/BE E - ECME R EPORTS ;14 -FEB-05
  118    ;;1.0;E C LAIMS MGMT  ENGINE;** 1,5,7,10,1 1,19,20,23 ,24**;JUN  2004;Build  27
  119    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  120    ;
  121   . . .
  122                               
  123   EN(BPRTYPE ) N %,BPAC REJ,BPAUTR EV,BPBEGDT ,BPCCRSN,B PDRGCL,BPD RUG,BPENDD T,BPEXCEL, BPNOW,BPPH ARM,BPINSI NF,BPMWC,B PQ,BPQSTDR G N BPREJC D,BPRLNRL, BPRPTNAM,B PRTBCK,BPS CR,BPSUMDE T,CODE,POS ,STAT,X,Y, BPINS,BPAR R,BPELIG,B POPCL N BP NBSTS,BPAL RC,BPELIG1 ,BPRESC,BP PAT,BPQSTP AT,BPBILL, BPMIN,BPMA X,BPSLC,BP SUC ; ;Ver ify that a  valid rep ort has be en request ed I ",1,2 ,3,4,5,6,7 ,8,9,"'[(" ,"_$G(BPRT YPE)_",")  W "<Invali d Menu Def inition -  Report Und efined>" H  3 Q S BPR PTNAM=$P(" PAYABLE CL AIMS^REJEC TED CLAIMS ^SUBMIT,NO T RELEASED  CLAIMS^RE VERSED CLA IMS^RECENT  TRANSACTI ONS^TOTALS ^CLOSED CL AIMS^SPEND ING ACCOUN T REPORT^R XS WITH NO N-BILLABLE  STATUS"," ^",BPRTYPE ) ; ;Neede d to conve rt lower c ase entrie s to upper  case S BP SLC="abcde fghijklmno pqrstuvwxy z" S BPSUC ="ABCDEFGH IJKLMNOPQR STUVWXYZ"  ; ;Get cur rent Date/ Time D NOW ^%DTC S Y= % D DD^%DT  S BPNOW=Y  ;
  124   DIV ; ;Pro mpt for EC ME Pharmac y Division (s) (No De fault) ;Se ts up BPPH ARM variab le and arr ay, BPPHAR M =0 ALL o r BPPHARM= 1,BPPHARM( ptr) for l ist S X=$$ SELPHARM^B PSRPT3() G :(X="^")&( $G(BPPHARM )="") EXIT  G:(X="^") &(BPPHARM= 1) DIVI X= "^" G EXIT  ; ;Prompt  to Displa y Summary  or Detail  Format (De fault to D etail) ;Re turns 1 fo r Summary,  0 for Det ail S BPSU MDET=$$SEL SMDET^BPSR PT3(2) I B PSUMDET="^ " G EXIT ;
  125   INSUR ; ;P rompt to a llow selec tion of Mu ltiple Ins urances or  All (Defa ult to ALL ) ;See des cription f or $$INSUR SEL^BPSSCR CU S BPINS =$$INSURSE L^BPSSCRCU (.BPARR,DU Z) I BPINS <1 G EXIT  S BPINSINF =$S(BPARR( 1.11)="I": BPARR("INS "),1:0) ;  If "I" Spe cific Insu rance(s) w as selecte d and the  user didn' t select ;  an Insura nce re-pro mpt for Sp ecific Ins urance(s)  or All I B PINSINF="; " G INSURE XIT ; ;Pro mpt to Dis play (C)MO P or (M)ai l or (W)in dow or (A) LL (Defaul t to ALL)  ;Returns ( A-ALL,M-Ma il,W-Windo w,C-CMOP)  I (",2,5,6 ,8,")'[BPR TYPE S BPM WC=$$SELMW C^BPSRPT3( "A") I BPM WC="^" G E XIT I (",1 ,2,3,4,7,9 ,")[BPRTYP E S BPMWC= $$SELMWC1^ BPSRPT3("A ") I BPMWC ="^" G EXI T ; ;Promp t to Displ ay (R)ealT ime Fills  or (B)ackb ills or (P )RO Option  or Re(S)u bmission o r (A)LL (D efault to  ALL) ;Retu rns (1-ALL ,2-RealTim e Fills,3- Backbills, 4-PRO Opti on,5-Resub mission) S  BPRTBCK=1  I (",2,5, 6,8,9,")'[ BPRTYPE S  BPRTBCK=$$ SELRTBCK^B PSRPT3(1)  I BPRTBCK= "^" G EXIT  I (",1,2, 3,4,7,9,") [BPRTYPE S  BPRTBCK=$ $SELRBPS^B PSRPT3() I  BPRTBCK=" ^" G EXIT  ;
  126   DGDGCL ; ; Prompt to  Display Sp ecific (D) rug or Dru g (C)lass  or (A)ll ( Default to  ALL) ;Ret urns (1-AL L,2-Drug,3 -Drug Clas s) S BPQST DRG=$$SELD RGAL^BPSRP T3(1) I BP QSTDRG="^"  Q ; ;Prom pt to Sele ct Drug (N o Default)  S BPDRUG= 0 I BPQSTD RG=2 D  G: BPDRUG="^"  EXIT G:BP DRUG=0 DGD GCLI BPDRU G="^" G EX IT . I (", 2,5,6,8,") '[BPRTYPE  S BPDRUG=$ $SELDRG^BP SRPT3() .  I (",1,2,3 ,4,7,9,")[ BPRTYPE S  BPDRUG=$$S ELDRG1^BPS RPT3A() ;  ;Prompt to  Select Dr ug Class ( No Default ) S BPDRGC L=0 I BPQS TDRG=3 D   G:BPDRGCL= "^" EXIT G :BPDRGCL=0  DGDGCLI B PDRGCL="^"  G EXIT .  I (",2,5,6 ,8,")'[BPR TYPE S BPD RGCL=$$SEL DRGCL^BPSR PT3() . I  (",1,2,3,4 ,7,9,")[BP RTYPE S BP DRGCL=$$SE LDC^BPSRPT 3A() ; ;Re port Speci fic Prompt s ; ;Promp t to selec t Date Ran ge ;Return s (Start D ate^End Da te) I (",1 ,2,3,4,5,6 ,7,8,9,")[ BPRTYPE S  BPBEGDT=$$ SELDATE^BP SRPT3(BPRT YPE) D  I  BPBEGDT="^ " G EXIT . I BPBEGDT= "^" Q .S B PENDDT=$P( BPBEGDT,U, 2) .S BPBE GDT=$P(BPB EGDT,U) ;  ;Prompt to  Include ( R)ELEASED  or (N)OT R ELEASED or  (A)LL (De fault to R ELEASED) ; Returns (1 -ALL,2-REL EASED,3-NO T RELEASED ) S BPRLNR L=$S(BPRTY PE=3:3,1:1 ) I (",1,2 ,4,6,7,8,9 ,")[BPRTYP E S BPRLNR L=$$SELRLN RL^BPSRPT4 ($S(BPRTYP E=9:1,1:2) ) I BPRLNR L="^" G EX IT ; ;Prom pt to Incl ude (S)pec ific Rejec t Code or  (A)LL (Def ault to AL L) ;Return s: 0=ALL ;  ^=if user  entered " ^" ; ptr=s tring of p tr's delim ited with  a comma e. g. BPREJCD ="95,100,"  ; (ptr is  the Point er to the  Selected R eject Code  in #90023 13.93) S B PREJCD=0 I  (",2,")[B PRTYPE S B PREJCD=$$S ELREJCD^BP SRPT4() I  BPREJCD="^ " G EXIT ;  ;Prompt t o Include  Auto(R)eve rsed or (A )LL (Defau lt to ALL)  ;Returns  (0-All,1-A utoReverse d) S BPAUT REV=0 I (" ,4,")[BPRT YPE S BPAU TREV=$$SEL AUREV^BPSR PT4(0) I B PAUTREV="^ " G EXIT ;  ;Prompt t o Include  A(C)cepted  or (R)eje cted or (A )LL (Defau lt to REJE CTED) ;Ret urns (0-Al l,1-Reject ed,2-Accep ted) S BPA CREJ=0 I ( ",4,")[BPR TYPE S BPA CREJ=$$SEL ACREJ^BPSR PT4(1) I B PACREJ="^"  G EXIT ;C CR ; ;Prom pt to Incl ude (S)pec ific Close  Claim Rea son or (A) ll (Defaul t to All)  ;Returns ( 0-All,ptr- Pointer to  #356.8) S  BPCCRSN=0  I (",7,") [BPRTYPE=7  S BPCCRSN =$$SELCCRS N^BPSRPT4( 0) G:BPCCR SN="" CCR  I BPCCRSN= "^" G EXIT  ; ;;Promp t for Elig ibility In dicator fo r payable,  rejected,  reversed  and closed  claims re port ;;Ret urns (V=VE TERAN,T=TR ICARE,C=CH AMPVA,0=Al l)
  127    ;;S BPELI G=0 I (",1 ,4,7,")[BP RTYPE S BP ELIG=$$SEL ELIG^BPSRP T3(1) I BP ELIG="^" G  EXIT ; ;P rompt for  All or Mos t Recent ( Non-Billab le Status  Report onl y) ;Return s A - All,  R - Most  Recent S B PALRC=0 I  (",9,")[BP RTYPE S BP ALRC=$$SEL ALRC^BPSRP T3() I BPA LRC="^" G  EXIT ; ;Pr ompt for o ne, multip le or (A)l l Eligibil ity Indica tor for No n-Billable  Status an d Rejected  Claims Re port
  128    ;Returns  (0-All, 1- selection)  ; If 1, B PARR("ELIG ",xx) is s et for eac h eligibil ity select ed - xx="V ", "T" or  "C" ;Sets  up BPELIG1  variable,  returns 0  if (A)ll  was select ed or 1. I f BPELIG1= 1 then the  array ; B PARR("ELIG ") is set,  BPARR("EL IG",xx) fo r each eli gibility s elected -  xx="V", "T " or "C" S  BPELIG1=0  I (",1,2, 3,4,7,9,") [BPRTYPE S  BPELIG1=$ $SELELIG1^ BPSRPT3()  I BPELIG1= "^" G EXIT  ; ;Prompt  for Open/ Closed/All  claims ;R eturns (1= Closed,2=O pen,0=All)  S BPOPCL= 0 I (",2," )[BPRTYPE  S BPOPCL=$ $SELOPCL^B PSRPT3(2)  I BPOPCL=" ^" G EXIT  ; ;Prompt  to select  SPECIFIC P RESCRIBER( S) or (A)l l Prescrib ers ;Retur ns: 0=ALL, ^=exit ;if  Specific  Prescriber  was selec ted ;Retur ns: BPRESC =a string  of prescri ber ien's  separated  by a comma  S BPRESC= 0 I (",2," )[BPRTYPE  S BPRESC=$ $SELPRESC^ BPSRPT3A()  I BPRESC= "^" G EXIT  ;
  129   PATIENT ;  ;Prompt to  select (P )atients o r (A)LL Pa tients ;Re turns: (0= ALL,1=Pati ent,^=exit ) S BPQSTP AT=0 I (", 1,2,3,4,7, 9,")[BPRTY PE S BPQST PAT=$$SELP A^BPSRPT3A () I BPQST PAT="^" G  EXIT ; ;If  (P)atient s was sele cted, prom pt for one  or more p atients ;R eturns: BP PAT=a stri ng of pati ent ien's  separated  by a comma  I BPQSTPA T=1 S BPPA T=$$SELPAT ^BPSRPT3A( ) G:BPPAT= "^" EXIT G :BPPAT=0 P ATIENT I B PPAT="^" G  EXIT ; ;P rompt to s elect(R)an ge for Bil led Amount  or (A)LL  ;Returns:  (0=ALL,1=R ange,^=exi t) S BPBIL L=0 I (",1 ,2,3,4,9," )[BPRTYPE  S BPBILL=$ $SELBAMT^B PSRPT3A()  I BPBILL=" ^" G EXIT  ;If Range  of Billed  Amount was  selected  prompt for  Minimum a nd Maximum  ;Returns:  BPMIN=min imum amoun t entered,  BPMAX=max imum amoun t entered  S (BPMIN,B PMAX)=0 I  BPBILL=1 W  !,"Range  for Billed  Amount" D   I (BPMIN ="^")!(BPM AX="^") G  EXIT . S B PMIN=$$SEL BMIN^BPSRP T3A() I BP MIN="^" Q  . S BPMAX= $$SELBMAX^ BPSRPT3A()  ; ;Prompt  for Non-B illable St atus (Non- Billable S tatus Repo rt only) ; Sets up BP NBSTS vari able and a rray, BPNB STS=0 ALL  or BPNBSTS =1,BPNBSTS (xx) for l ist S BPNB STS=0 I (" ,9,")[BPRT YPE S BPNB STS=$$SELN BSTS^BPSRP T3() I BPN BSTS="^" G  EXIT ; ;P rompt for  Excel Capt ure (Detai l Only) S  BPEXCEL=0  I 'BPSUMDE T S BPEXCE L=$$SELEXC EL^BPSRPT4 () I BPEXC EL="^" G E XIT ; ;Pro mpt for th e Device I  'BPEXCEL  D .W !!,"W ARNING - T HIS REPORT  REQUIRES  THAT A DEV ICE WITH 1 32 COLUMN  WIDTH BE U SED." .W ! ,"IT WILL  NOT DISPLA Y CORRECTL Y USING 80  COLUMN WI DTH DEVICE S",! S BPQ =0 D DEVIC E(BPRPTNAM ) Q:BPQ ;  ;Compile a nd Run the  Report D  RUN(BPEXCE L,BPRPTNAM ,BPSUMDET)  I 'BPQ D  PAUSE2^BPS RPT1 ;EXIT  Q
  130     
  131  
  132   Do not dis play the h elp text w hen an opt ion is rep eated for  the Fill T ype filter  question.   The syst em should  filter out  the dupli cate respo nses and d isplay a l ist of the  items sel ected. Als o if ‘A’   is one of  the select ions made  by the use r then tre at as if A LL was sel ected.
  133  
  134   Subroutine  Name
  135   SELBPS^BPS RPT3
  136   Enhancemen t Category
  137    New
  138    Modify
  139    Delete
  140    No Change
  141   Current Lo gic
  142  
  143   SELRBPS()  ;
  144    ;
  145    ; BPSRBST R = string  of valid  codes
  146    ;
  147    ; Upon co mpletion o f prompt,  values wil l be place d into a s tring deli mited
  148    ; by comm as. e.g. P ,R
  149    ;
  150    ; If user  selected  (A)ll then  1 will be  stored in  BPARR
  151    ;
  152    ; User in put values  are tempo rary store d in array  BPSRBPS t o eliminat e duplicat
  153    ; entries .
  154    ;
  155   BPRBPS ; R ealtime /  Backbills  / Pro Opti on / Resub mission /  All
  156    N BPARR,B PSRBPS,BPS ERR,BPSRBS TR,BPSSEL, BPSX
  157    N DIR,DIR UT,DTOUT,D UOUT,X,Y
  158    ;
  159    S BPSRBST R=",R,B,P, S,A,"
  160    S DIR(0)= "FO^0:7"
  161    S DIR("A" ,1)=""
  162    S DIR("A" ,2)="      Select one  or more o f the foll owing:"
  163    S DIR("A" ,3)=""
  164    S DIR("A" ,4)="           R          Real  Time Fills "
  165    S DIR("A" ,5)="           B          Backb ill"
  166    S DIR("A" ,6)="           P          PRO O ption"
  167    S DIR("A" ,7)="           S          ReSub mission"
  168    S DIR("A" ,8)="           A          ALL"
  169    S DIR("A" ,9)=""
  170    S DIR("A" )="Display  (R)ealTim e, (B)ackb ills, (P)R O Option,  Re(S)ubmis sion or (A )ll"
  171    S DIR("B" )="A" S:$G (BPARR("RB PS"))'=""  DIR("B")=B PARR("RBPS ")
  172    S DIR("?" ,1)="Enter  a single  response o r multiple  responses  separated  by commas ."
  173    S DIR("?" ,2)=" Exam ple:"
  174    S DIR("?" ,3)="  B"
  175    S DIR("?" )="  B,P"
  176    D ^DIR K  DIR
  177    ;
  178    I ($G(DUO UT)=1)!($G (DTOUT)=1) !($D(DIRUT )) Q "^"
  179    ;
  180    ;Convert  any lower  case to up per case
  181    S X=$TR(X ,BPSLC,BPS UC)
  182    ;
  183    ; Loop th rough user  input (re turned in  variable X ).
  184    ; Display  warning m essage if  any user i nput selec tion is no t included
  185    ; in the  string of  acceptable  codes (BP SRBSTR) an d re-promp t question .
  186    ; Assign  valid sele ctions to  BPRTBCK ar ray. This  array will  prevent
  187    ; duplica te entries  from bein g saved to  the user' s profile.
  188    ;
  189    K BPSRBPS
  190    S (BPSSEL ,BPSERR)=" "
  191    F BPSX=1: 1:$L(X,"," ) D
  192    . S BPSSE L=$P(X,"," ,BPSX)
  193    . I BPSRB STR'[(","_ BPSSEL_"," ) W !," ", BPSSEL," i s not a va lid entry. " S BPSERR =1 Q
  194    . S BPSRB PS(BPSSEL) =""
  195    ;
  196    I $G(BPSE RR)=1 G BP RBPS
  197    ;
  198    ; If user  selected  (A)ll, set  profile s etting to  ALL.
  199    I $D(BPSR BPS("A"))  S BPARR("R BPS")=1
  200    E  D  ; U ser did no t enter "A ".
  201    . ;
  202    . ; At th is point u ser select ions are v alid and d o not incl ude "A".
  203    . ; Loop  through va lid user s elections.  Set selec tions into  a
  204    . ; comma  delimited  string be fore assig ning to BP ARR array.
  205    . ;
  206    . S (BPSS EL,BPSSELN )=""
  207    . F  S BP SSEL=$O(BP SRBPS(BPSS EL)) Q:BPS SEL=""  D
  208    . . ; Dis play the u ser select ions
  209    . . W !,? 10,$S(BPSS EL="R":"RE ALTIME",BP SSEL="B":" BACKBILLS" ,BPSSEL="P ":"PRO OPT ION",BPSSE L="S":"RES UBMISSION" ,1:"")
  210    . . S BPS RBPS=$G(BP SRBPS)_BPS SEL_","
  211    . S BPSRB PS=$E(BPSR BPS,1,($L( BPSRBPS)-1 ))
  212    ;
  213    ; If ALL  wasn't sel ected conv ert BPSRBP S to numer ical a val ue, like e xisting fu nctionalit y in SELRT BCK^BPSRPT 3.
  214    I '$D(BPS RBPS("A"))  D
  215    . N RTBCK X,NRTBCK,I
  216    . S NRTBC K=""
  217    . I $L(BP SRBPS)=1 D
  218    . . S NRT BCK=$S(BPS RBPS="R":2 ,BPSRBPS=" B":3,BPSRB PS="P":4,B PSRBPS="S" :5,1:"")
  219    . . S BPA RR("RBPS") =NRTBCK
  220    . E  D
  221    . . F I=1 :1:$L(BPSR BPS,",") S  RTBCKX=$P (BPSRBPS," ,",I),NRTB CK=NRTBCK_ $S(RTBCKX= "R":2,RTBC KX="B":3,R TBCKX="P": 4,RTBCKX=" S":5,1:"") _","
  222    . . S BPA RR("RBPS") =$E(NRTBCK ,1,$L(NRTB CK)-1)
  223    ;
  224    Q BPARR(" RBPS")
  225  
  226   Modified L ogic (Chan ges are hi ghlighted)
  227  
  228   SELRBPS()  ;
  229    ;
  230    ; BPSRBST R = string  of valid  codes
  231    ;
  232    ; Upon co mpletion o f prompt,  values wil l be place d into a s tring deli mited
  233    ; by comm as. e.g. P ,R
  234    ;
  235    ; If user  selected  (A)ll then  1 will be  stored in  BPARR
  236    ;
  237    ; User in put values  are tempo rary store d in array  BPSRBPS t o eliminat e duplicat
  238    ; entries .
  239    ;
  240   BPRBPS ; R ealtime /  Backbills  / Pro Opti on / Resub mission /  All
  241    N BPARR,B PSRBPS,BPS ERR,BPSRBS TR,BPSSEL, BPSX
  242    N DIR,DIR UT,DTOUT,D UOUT,X,Y
  243    ;
  244    S BPSRBST R=",R,B,P, S,A,"
  245    S DIR(0)= "FO^0:9"
  246    S DIR("A" ,1)=""
  247    S DIR("A" ,2)="      Select one  or more o f the foll owing:"
  248    S DIR("A" ,3)=""
  249    S DIR("A" ,4)="           R          Real  Time Fills "
  250    S DIR("A" ,5)="           B          Backb ill"
  251    S DIR("A" ,6)="           P          PRO O ption"
  252    S DIR("A" ,7)="           S          ReSub mission"
  253    S DIR("A" ,8)="           A          ALL"
  254    S DIR("A" ,9)=""
  255    S DIR("A" )="Display  (R)ealTim e, (B)ackb ills, (P)R O Option,  Re(S)ubmis sion or (A )ll"
  256    S DIR("B" )="A" S:$G (BPARR("RB PS"))'=""  DIR("B")=B PARR("RBPS ")
  257    S DIR("?" ,1)="Enter  a single  response o r multiple  responses  separated  by commas ."
  258    S DIR("?" ,2)=" Exam ple:"
  259    S DIR("?" ,3)="  B"
  260    S DIR("?" )="  B,P"
  261    D ^DIR K  DIR
  262    ;
  263    I ($G(DUO UT)=1)!($G (DTOUT)=1) !($D(DIRUT )) Q "^"
  264    ;
  265    ;Convert  any lower  case to up per case
  266    S X=$TR(X ,BPSLC,BPS UC)
  267    ;
  268    ;If 'A' w as one of  the select ions it ov errides al l other se lections.
  269    I X[",",X ["A" S X=" A" 
  270    ;
  271    ; Loop th rough user  input (re turned in  variable X ).
  272    ; Display  warning m essage if  any user i nput selec tion is no t included
  273    ; in the  string of  acceptable  codes (BP SRBSTR) an d re-promp t question .
  274    ; Assign  valid sele ctions to  BPRTBCK ar ray. This  array will  prevent
  275    ; duplica te entries  from bein g saved to  the user' s profile.
  276    ;
  277    K BPSRBPS
  278    S (BPSSEL ,BPSERR)=" "
  279    F BPSX=1: 1:$L(X,"," ) D
  280    . S BPSSE L=$P(X,"," ,BPSX)
  281    . I BPSRB STR'[(","_ BPSSEL_"," ) W !," ", BPSSEL," i s not a va lid entry. " S BPSERR =1 Q
  282    . S BPSRB PS(BPSSEL) =""
  283    ;
  284    I $G(BPSE RR)=1 G BP RBPS
  285    ;
  286    ; If user  selected  (A)ll, set  profile s etting to  ALL.
  287    I $D(BPSR BPS("A"))  S BPARR("R BPS")=1
  288    E  D  ; U ser did no t enter "A ".
  289    . ;
  290    . ; At th is point u ser select ions are v alid and d o not incl ude "A".
  291    . ; Loop  through va lid user s elections.  Set selec tions into  a
  292    . ; comma  delimited  string be fore assig ning to BP ARR array.
  293    . ;
  294    . S (BPSS EL,BPSSELN )=""
  295    . F  S BP SSEL=$O(BP SRBPS(BPSS EL)) Q:BPS SEL=""  D
  296    . . ; Dis play the u ser select ions
  297    . . W !,? 10,$S(BPSS EL="R":"RE ALTIME",BP SSEL="B":" BACKBILLS" ,BPSSEL="P ":"PRO OPT ION",BPSSE L="S":"RES UBMISSION" ,1:"")
  298    . . S BPS RBPS=$G(BP SRBPS)_BPS SEL_","
  299    . S BPSRB PS=$E(BPSR BPS,1,($L( BPSRBPS)-1 ))
  300    ;
  301    ; If ALL  wasn't sel ected conv ert BPSRBP S to numer ical a val ue, like e xisting fu nctionalit y in SELRT BCK^BPSRPT 3.
  302    I '$D(BPS RBPS("A"))  D
  303    . N RTBCK X,NRTBCK,I
  304    . S NRTBC K=""
  305    . I $L(BP SRBPS)=1 D
  306    . . S NRT BCK=$S(BPS RBPS="R":2 ,BPSRBPS=" B":3,BPSRB PS="P":4,B PSRBPS="S" :5,1:"")
  307    . . S BPA RR("RBPS") =NRTBCK
  308    . E  D
  309    . . F I=1 :1:$L(BPSR BPS,",") S  RTBCKX=$P (BPSRBPS," ,",I),NRTB CK=NRTBCK_ $S(RTBCKX= "R":2,RTBC KX="B":3,R TBCKX="P": 4,RTBCKX=" S":5,1:"") _","
  310    . . S BPA RR("RBPS") =$E(NRTBCK ,1,$L(NRTB CK)-1)
  311    ;
  312    Q BPARR(" RBPS")
  313      
  314  
  315   For the El igibility  and Fill L ocation fi lter promp ts, if ‘A’  is one of  the selec tions made  by the us er then tr eat as if  ALL was se lected.
  316  
  317   Subroutine  Name
  318   SELELIG1^B PSRPT3
  319   Enhancemen t Category
  320    New
  321    Modify
  322    Delete
  323    No Change
  324   Current Lo gic
  325  
  326   SELELIG1()  ;
  327    ; Select  multiple E ligibiliti es
  328    ; 
  329    ; Input V ariable ->  none
  330    ; Return  Value   ->  0: All, 1 : Selected  Eligibili ties; '^'  = Exit
  331    ;                                           
  332    ; Output  Variable - > BPELIG1  = 1 - One  or More El igibilitie s Selected
  333    ;                               = 0 - User  Entered ' ALL'
  334    ;                               = "^" - Us er quit
  335    ;                              
  336    ; If BPEL IG1 = 1 th en the BPE LIG1 array  will be d efined whe re:
  337    ;    BPEL IG1("C")=" CHAMPVA"
  338    ;    BPEL IG1("T")=" TRICARE"
  339    ;    BPEL IG1("V")=" VETERAN"
  340    ;
  341    ;
  342   BPSELIG1 ;
  343    ;Reset BP ELIG1 arra y
  344    K BPELIG1
  345    N DIR,DTO UT,DUOUT,D IRUT,DIROU T,X,Y,P
  346    N BPSVTC, BPSERR,BPS VTCSTR,BPS SEL,BPSX
  347    ;
  348    S BPSVTCS TR=",V,T,C ,A,"
  349    S DIR(0)= "FO^0:7"
  350    S DIR("A" ,1)=""
  351    S DIR("A" ,2)="Selec t one or m ore of the  following :"
  352    S DIR("A" ,3)=""
  353    S DIR("A" ,4)="      V          VETERAN"
  354    S DIR("A" ,5)="      T          TRICARE"
  355    S DIR("A" ,6)="      C          CHAMPVA"
  356    S DIR("A" ,7)="      A          ALL"
  357    S DIR("A" ,8)=""
  358    S DIR("A" )="Display  (V)ETERAN  or (T)RIC ARE or (C) HAMPVA or  (A)LL"
  359    S DIR("B" )="A" S:$G (BPARR("EL IG"))'=""  DIR("B")=B PARR("ELIG ")
  360    S DIR("?" ,1)="Enter  a single  response o r multiple  responses  separated  by commas ."
  361    S DIR("?" ,2)=" Exam ple:"
  362    S DIR("?" ,3)=" T"
  363    S DIR("?" )=" T,C"
  364    D ^DIR K  DIR
  365    I ($G(DUO UT)=1)!($G (DTOUT)=1) !($D(DIRUT )) Q "^"
  366    ;
  367    ;Convert  any lower  case to up per case
  368    S X=$TR(X ,BPSLC,BPS UC)
  369    ;
  370    ; Loop th rough user  input (re turned in  variable X ).
  371    ; Display  warning m essage if  any user i nput selec tion is no t included
  372    ; in the  string of  acceptable  codes (BP SVTCSTR) a nd re-prom pt questio n.
  373    ; Assign  valid sele ctions to  BPSVTC arr ay. This a rray will  prevent
  374    ; duplica te entries  from bein g saved to  the user' s profile.
  375    ;
  376    K BPSVTC
  377    S BPSERR= ""
  378    F BPSX=1: 1:$L(X,"," ) D
  379    . S BPSSE L=$P(X,"," ,BPSX)
  380    . I BPSVT CSTR'[("," _BPSSEL_", ") W !," " ,BPSSEL,"  is not a v alid entry ." S BPSER R=1 Q
  381    . ; if Al l was sele cted don't  include i n array
  382    .   I BPS SEL'="A" S  BPELIG1(B PSSEL)=$S( BPSSEL="V" :"VETERAN" ,BPSSEL="T ":"TRICARE ",BPSSEL=" C":"CHAMPV A",1:"")
  383    ;
  384    I $G(BPSE RR)=1 G BP SELIG1
  385    ;
  386    ; ALL was  selected
  387    I X="A" S  BPELIG1=0
  388    E  D  ; 
  389    . ;User s elected on e or more  eligibilit ies
  390    . S BPELI G1=1
  391    . ;
  392    . ; Displ ay the use r selectio ns
  393    . ;
  394    . S BPSSE L=""
  395    . F  S BP SSEL=$O(BP ELIG1(BPSS EL)) Q:BPS SEL=""  W  !,?10,BPEL IG1(BPSSEL )
  396    ;
  397    Q BPELIG1
  398  
  399   Modified L ogic (Chan ges are hi ghlighted)
  400  
  401   SELELIG1()  ;
  402    ; Select  multiple E ligibiliti es
  403    ; 
  404    ; Input V ariable ->  none
  405    ; Return  Value   ->  0: All, 1 : Selected  Eligibili ties; '^'  = Exit
  406    ;                                           
  407    ; Output  Variable - > BPELIG1  = 1 - One  or More El igibilitie s Selected
  408    ;                               = 0 - User  Entered ' ALL'
  409    ;                               = "^" - Us er quit
  410    ;                              
  411    ; If BPEL IG1 = 1 th en the BPE LIG1 array  will be d efined whe re:
  412    ;    BPEL IG1("C")=" CHAMPVA"
  413    ;    BPEL IG1("T")=" TRICARE"
  414    ;    BPEL IG1("V")=" VETERAN"
  415    ;
  416    ;
  417   BPSELIG1 ;
  418    ;Reset BP ELIG1 arra y
  419    K BPELIG1
  420    N DIR,DTO UT,DUOUT,D IRUT,DIROU T,X,Y,P
  421    N BPSVTC, BPSERR,BPS VTCSTR,BPS SEL,BPSX
  422    ;
  423    S BPSVTCS TR=",V,T,C ,A,"
  424    S DIR(0)= "FO^0:7"
  425    S DIR("A" ,1)=""
  426    S DIR("A" ,2)="Selec t one or m ore of the  following :"
  427    S DIR("A" ,3)=""
  428    S DIR("A" ,4)="      V          VETERAN"
  429    S DIR("A" ,5)="      T          TRICARE"
  430    S DIR("A" ,6)="      C          CHAMPVA"
  431    S DIR("A" ,7)="      A          ALL"
  432    S DIR("A" ,8)=""
  433    S DIR("A" )="Display  (V)ETERAN  or (T)RIC ARE or (C) HAMPVA or  (A)LL"
  434    S DIR("B" )="A" S:$G (BPARR("EL IG"))'=""  DIR("B")=B PARR("ELIG ")
  435    S DIR("?" ,1)="Enter  a single  response o r multiple  responses  separated  by commas ."
  436    S DIR("?" ,2)=" Exam ple:"
  437    S DIR("?" ,3)=" T"
  438    S DIR("?" )=" T,C"
  439    D ^DIR K  DIR
  440    I ($G(DUO UT)=1)!($G (DTOUT)=1) !($D(DIRUT )) Q "^"
  441    ;
  442    ;Convert  any lower  case to up per case
  443    S X=$TR(X ,BPSLC,BPS UC)
  444    ;
  445    ;If 'A' w as one of  the select ions it ov errides al l other se lections.
  446    I X[",",X ["A" S X=" A"
  447    ;
  448    ; Loop th rough user  input (re turned in  variable X ).
  449    ; Display  warning m essage if  any user i nput selec tion is no t included
  450    ; in the  string of  acceptable  codes (BP SVTCSTR) a nd re-prom pt questio n.
  451    ; Assign  valid sele ctions to  BPSVTC arr ay. This a rray will  prevent
  452    ; duplica te entries  from bein g saved to  the user' s profile.
  453    ;
  454    K BPSVTC
  455    S BPSERR= ""
  456    F BPSX=1: 1:$L(X,"," ) D
  457    . S BPSSE L=$P(X,"," ,BPSX)
  458    . I BPSVT CSTR'[("," _BPSSEL_", ") W !," " ,BPSSEL,"  is not a v alid entry ." S BPSER R=1 Q
  459    . ; if Al l was sele cted don't  include i n array
  460    .   I BPS SEL'="A" S  BPELIG1(B PSSEL)=$S( BPSSEL="V" :"VETERAN" ,BPSSEL="T ":"TRICARE ",BPSSEL=" C":"CHAMPV A",1:"")
  461    ;
  462    I $G(BPSE RR)=1 G BP SELIG1
  463    ;
  464    ; ALL was  selected
  465    I X="A" S  BPELIG1=0
  466    E  D  ; 
  467    . ;User s elected on e or more  eligibilit ies
  468    . S BPELI G1=1
  469    . ;
  470    . ; Displ ay the use r selectio ns
  471    . ;
  472    . S BPSSE L=""
  473    . F  S BP SSEL=$O(BP ELIG1(BPSS EL)) Q:BPS SEL=""  W  !,?10,BPEL IG1(BPSSEL )
  474    ;
  475    Q BPELIG1
  476      
  477  
  478  
  479   Subroutine  Name
  480   SELMWC1^BP SRPT3
  481   Enhancemen t Category
  482    New
  483    Modify
  484    Delete
  485    No Change
  486   Current Lo gic
  487  
  488   SELMWC1(DF LT) ;
  489    ; Upon co mpletion o f prompt,  values wil l be place d into a s tring deli mited
  490    ; by comm as. e.g. C ,M
  491    ; 
  492    ; If user  includes  (A)ll as a  code, "A"  will be s tored in B PARR
  493    ; array.  e.g. Entry  of C,M,A  will save  as BPARR(" MWC")="A"
  494    ; 
  495    ; User in put values  are tempo rary store d in array  BPSMWC to  eliminate  duplicate  
  496    ; entries . e.g. Ent ry of C,M, C will sav e as BPARR ("MWC")="C ,M"
  497    ; 
  498   BPSMWC ;
  499    N DIR,DIR UT,DTOUT,D UOUT,X,Y
  500    N BPARR,B PSMWC,BPSE RR,BPSMWCS TR,BPSSEL, BPSX
  501    ;
  502    S BPSMWCS TR=",C,M,W ,A,"
  503    S DIR(0)= "FO^0:7"
  504    S DIR("A" ,1)=""
  505    S DIR("A" ,2)="      Select one  or more o f the foll owing:"
  506    S DIR("A" ,3)=""
  507    S DIR("A" ,4)="           C          CMOP"
  508    S DIR("A" ,5)="           M          Mail"
  509    S DIR("A" ,6)="           W          Windo w"
  510    S DIR("A" ,7)="           A          ALL"
  511    S DIR("A" ,8)=""
  512    S DIR("A" )="Display  (C)MOP or  (M)ail or  (W)indow  or (A)ll"
  513    S DIR("B" )="A" S:$G (BPARR("MW C"))'="" D IR("B")=BP ARR("MWC")
  514    S DIR("?" ,1)="Enter  a single  response o r multiple  responses  separated  by commas ."
  515    S DIR("?" ,2)=" Exam ple:"
  516    S DIR("?" ,3)="  C"
  517    S DIR("?" )="  C,M"
  518    D ^DIR K  DIR
  519    I ($G(DUO UT)=1)!($G (DTOUT)=1) !($D(DIRUT )) Q "^"
  520    ;
  521    ;Convert  any lower  case to up per case
  522    S X=$TR(X ,BPSLC,BPS UC)
  523    ;
  524    ; Loop th rough user  input (re turned in  variable X ).
  525    ; Display  warning m essage if  any user i nput selec tion is no t included
  526    ; in the  string of  acceptable  codes (BP SMWCSTR) a nd re-prom pt questio n.
  527    ; Assign  valid sele ctions to  BPSMWC arr ay. This a rray will  prevent
  528    ; duplica te entries  from bein g saved to  the user' s profile.
  529    ;
  530    K BPSMWC
  531    S BPSERR= ""
  532    F BPSX=1: 1:$L(X,"," ) D
  533    . S BPSSE L=$P(X,"," ,BPSX)
  534    . I BPSMW CSTR'[("," _BPSSEL_", ") W !," " ,BPSSEL,"  is not a v alid entry ." S BPSER R=1 Q
  535    . S BPSMW C(BPSSEL)= ""
  536    ;
  537    I $G(BPSE RR)=1 G BP SMWC
  538    ;
  539    ; If user  included  (A)ll as a  selection , set prof ile settin g to "A".
  540    ;
  541    I $D(BPSM WC("A")) S  BPARR("MW C")="A"
  542    E  D  ; U ser did no t enter "A ".
  543    . ;
  544    . ; At th is point u ser select ions are v alid, do n ot include  "A".
  545    . ; Loop  through an d set sele ctions int o a comma  delimited
  546    . ; strin g before a ssigning t o BPARR ar ray.
  547    . ;
  548    . S BPSSE L=""
  549    . F  S BP SSEL=$O(BP SMWC(BPSSE L)) Q:BPSS EL=""  D
  550    . . ; Dis play the u ser select ions
  551    . . W !,? 10,$S(BPSS EL="C":"CM OP",BPSSEL ="M":"MAIL ",BPSSEL=" W":"WINDOW ",1:"")
  552    . . S BPS MWC=$G(BPS MWC)_BPSSE L_","
  553    . S BPSMW C=$E(BPSMW C,1,($L(BP SMWC)-1))
  554    . S BPARR ("MWC")=BP SMWC
  555    ;
  556    Q BPARR(" MWC")
  557  
  558   Modified L ogic (Chan ges are hi ghlighted)
  559  
  560   SELMWC1(DF LT) ;
  561    ; Upon co mpletion o f prompt,  values wil l be place d into a s tring deli mited
  562    ; by comm as. e.g. C ,M
  563    ; 
  564    ; If user  includes  (A)ll as a  code, "A"  will be s tored in B PARR
  565    ; array.  e.g. Entry  of C,M,A  will save  as BPARR(" MWC")="A"
  566    ; 
  567    ; User in put values  are tempo rary store d in array  BPSMWC to  eliminate  duplicate  
  568    ; entries . e.g. Ent ry of C,M, C will sav e as BPARR ("MWC")="C ,M"
  569    ; 
  570   BPSMWC ;
  571    N DIR,DIR UT,DTOUT,D UOUT,X,Y
  572    N BPARR,B PSMWC,BPSE RR,BPSMWCS TR,BPSSEL, BPSX
  573    ;
  574    S BPSMWCS TR=",C,M,W ,A,"
  575    S DIR(0)= "FO^0:7"
  576    S DIR("A" ,1)=""
  577    S DIR("A" ,2)="      Select one  or more o f the foll owing:"
  578    S DIR("A" ,3)=""
  579    S DIR("A" ,4)="           C          CMOP"
  580    S DIR("A" ,5)="           M          Mail"
  581    S DIR("A" ,6)="           W          Windo w"
  582    S DIR("A" ,7)="           A          ALL"
  583    S DIR("A" ,8)=""
  584    S DIR("A" )="Display  (C)MOP or  (M)ail or  (W)indow  or (A)ll"
  585    S DIR("B" )="A" S:$G (BPARR("MW C"))'="" D IR("B")=BP ARR("MWC")
  586    S DIR("?" ,1)="Enter  a single  response o r multiple  responses  separated  by commas ."
  587    S DIR("?" ,2)=" Exam ple:"
  588    S DIR("?" ,3)="  C"
  589    S DIR("?" )="  C,M"
  590    D ^DIR K  DIR
  591    I ($G(DUO UT)=1)!($G (DTOUT)=1) !($D(DIRUT )) Q "^"
  592    ;
  593    ;Convert  any lower  case to up per case
  594    S X=$TR(X ,BPSLC,BPS UC)
  595    ;
  596    ;If 'A' w as one of  the select ions it ov errides al l other se lections.
  597    I X[",",X ["A" S X=" A" 
  598    ;
  599    ; Loop th rough user  input (re turned in  variable X ).
  600    ; Display  warning m essage if  any user i nput selec tion is no t included
  601    ; in the  string of  acceptable  codes (BP SMWCSTR) a nd re-prom pt questio n.
  602    ; Assign  valid sele ctions to  BPSMWC arr ay. This a rray will  prevent
  603    ; duplica te entries  from bein g saved to  the user' s profile.
  604    ;
  605    K BPSMWC
  606    S BPSERR= ""
  607    F BPSX=1: 1:$L(X,"," ) D
  608    . S BPSSE L=$P(X,"," ,BPSX)
  609    . I BPSMW CSTR'[("," _BPSSEL_", ") W !," " ,BPSSEL,"  is not a v alid entry ." S BPSER R=1 Q
  610    . S BPSMW C(BPSSEL)= ""
  611    ;
  612    I $G(BPSE RR)=1 G BP SMWC
  613    ;
  614    ; If user  included  (A)ll as a  selection , set prof ile settin g to "A".
  615    ;
  616    I $D(BPSM WC("A")) S  BPARR("MW C")="A"
  617    E  D  ; U ser did no t enter "A ".
  618    . ;
  619    . ; At th is point u ser select ions are v alid, do n ot include  "A".
  620    . ; Loop  through an d set sele ctions int o a comma  delimited
  621    . ; strin g before a ssigning t o BPARR ar ray.
  622    . ;
  623    . S BPSSE L=""
  624    . F  S BP SSEL=$O(BP SMWC(BPSSE L)) Q:BPSS EL=""  D
  625    . . ; Dis play the u ser select ions
  626    . . W !,? 10,$S(BPSS EL="C":"CM OP",BPSSEL ="M":"MAIL ",BPSSEL=" W":"WINDOW ",1:"")
  627    . . S BPS MWC=$G(BPS MWC)_BPSSE L_","
  628    . S BPSMW C=$E(BPSMW C,1,($L(BP SMWC)-1))
  629    . S BPARR ("MWC")=BP SMWC
  630    ;
  631    Q BPARR(" MWC")
  632      
  633  
  634  
  635   If the use r has sele cted speci fic Divisi on and the n doesn’t  make a sel ection, mo dify to re turn the u ser to the  ‘Select C ertain Pha rmacy (D)i visions or  (A)LL’ pr ompt.
  636  
  637  
  638   Subroutine  Name
  639   SELPHARM^B PSPRT3
  640   Enhancemen t Category
  641    New
  642    Modify
  643    Delete
  644    No Change
  645   Current Lo gic
  646  
  647    ; Select  the ECME P harmacy or  Pharmacie s ;  ; Inp ut Variabl e -> none  ; Return V alue -> ""  = Valid E ntry or En tries Sele cted ; ^ =  Exit ;  ;  Output Va riable ->  BPPHARM =  1 One or M ore Pharma cies Selec ted ; = 0  User Enter ed 'ALL' ;   ; If BPP HARM = 1 t hen the BP PHARM arra y will be  defined wh ere: ; BPP HARM(ptr)  = ptr ^ BP S PHARMACY  NAME and  ; ptr = In ternal Poi nter to BP S PHARMACI ES file (# 9002313.56 ) ; SELPHA RM() N DIC ,DIR,DIRUT ,DTOUT,DUO UT,X,Y ; ; Reset BPPH ARM array  K BPPHARM  ; ;First s ee if they  want to e nter indiv idual divi sions or A LL S DIR(0 )="S^D:DIV ISION;A:AL L" S DIR(" A")="Selec t Certain  Pharmacy ( D)ivisions  or (A)LL"  S DIR("L" ,1)="Selec t one of t he followi ng:" S DIR ("L",2)=""  S DIR("L" ,3)=" D DI VISION" S  DIR("L",4) =" A ALL"  D ^DIR K D IR ; ;Chec k for "^"  or timeout , otherwis e define B PPHARM I ( $G(DUOUT)= 1)!($G(DTO UT)=1) S Y ="^" E  S  BPPHARM=$S (Y="A":0,1 :1) ; ;If  division s elected, a sk prompt  I $G(BPPHA RM)=1 F  D   Q:Y="^"! (Y="")  .;  .;Prompt  for entry  .K X S DIC (0)="QEAM" ,DIC=90023 13.56,DIC( "A")="Sele ct ECME Ph armacy Div ision(s):  " .W ! D ^ DIC .; .;C heck for " ^" or time out  .I ($ G(DUOUT)=1 )!($G(DTOU T)=1) K BP PHARM S Y= "^" Q .; . ;Check for  blank ent ry, quit i f no previ ous select ions .I $G (X)="" S Y =$S($D(BPP HARM)>9:"" ,1:"^") K: Y="^" BPPH ARM Q .; . ;Handle De letes .I $ D(BPPHARM( +Y)) D  Q: Y="^"  I 1  ..N P ..S  P=Y  ;Sav e Original  Value ..S  DIR(0)="S ^Y:YES;N:N O",DIR("A" )="Delete  "_$P(P,U,2 )_" from y our list?"  ..S DIR(" B")="NO" D  ^DIR ..I  ($G(DUOUT) =1)!($G(DT OUT)=1) K  BPPHARM S  Y="^" Q .. I Y="Y" K  BPPHARM(+P ),BPPHARM( "B",$P(P,U ,2),+P) .. S Y=P  ;Re store Orig inal Value  ..K P .E   D ..;Defi ne new ent ries in BP PHARM arra y ..S BPPH ARM(+Y)=Y  ..S BPPHAR M("B",$P(Y ,U,2),+Y)= "" .; .;Di splay a li st of sele cted divis ions .I $D (BPPHARM)> 9 D ..N X  ..W !,?2," Selected:"  ..S X=""  F  S X=$O( BPPHARM("B ",X)) Q:X= ""  W !,?1 0,X ..K X  .Q ; K BPP HARM("B")  Q Y
  648  
  649   Modified L ogic (Chan ges are hi ghlighted)
  650  
  651    ; Select  the ECME P harmacy or  Pharmacie s ;  ; Inp ut Variabl e -> none  ; Return V alue -> ""  = Valid E ntry or En tries Sele cted ; ^ =  Exit ;  ;  Output Va riable ->  BPPHARM =  1 One or M ore Pharma cies Selec ted ; = 0  User Enter ed 'ALL' ;   ; If BPP HARM = 1 t hen the BP PHARM arra y will be  defined wh ere: ; BPP HARM(ptr)  = ptr ^ BP S PHARMACY  NAME and  ; ptr = In ternal Poi nter to BP S PHARMACI ES file (# 9002313.56 ) ; 
  652   SELPHARM()  N DIC,DIR ,DIRUT,DTO UT,DUOUT,X ,Y ; ;Rese t BPPHARM  array K BP PHARM ; ;F irst see i f they wan t to enter  individua l division s or ALL S  DIR(0)="S ^D:DIVISIO N;A:ALL" S  DIR("A")= "Select Ce rtain Phar macy (D)iv isions or  (A)LL" S D IR("L",1)= "Select on e of the f ollowing:"  S DIR("L" ,2)="" S D IR("L",3)= " D DIVISI ON" S DIR( "L",4)=" A  ALL" D ^D IR K DIR ;  ;Check fo r "^" or t imeout, ot herwise de fine BPPHA RM I ($G(D UOUT)=1)!( $G(DTOUT)= 1) S Y="^"  E  S BPPH ARM=$S(Y=" A":0,1:1)  ;SELPHRM1  ; ;If divi sion selec ted, ask p rompt I $G (BPPHARM)= 1 F  D  Q: Y="^"!(Y=" ")  .; .;P rompt for  entry .K X  S DIC(0)= "QEAM",DIC =9002313.5 6,DIC("A") ="Select E CME Pharma cy Divisio n(s): " .W  ! D ^DIC  .; .;Check  for "^" o r timeout   .I ($G(DU OUT)=1)!($ G(DTOUT)=1 ) K BPPHAR M S Y="^"  Q .; .;Che ck for bla nk entry ,  quit if n o previous  selection s .I $G(X) ="" S Y=$S ($D(BPPHAR M)>9:"",1: "^") Q  .;  .;Handle  Deletes .I  $D(BPPHAR M(+Y)) D   Q:Y="^"  I  1 ..N P . .S P=Y  ;S ave Origin al Value . .S DIR(0)= "S^Y:YES;N :NO",DIR(" A")="Delet e "_$P(P,U ,2)_" from  your list ?" ..S DIR ("B")="NO"  D ^DIR .. I ($G(DUOU T)=1)!($G( DTOUT)=1)  K BPPHARM  S Y="^" Q  ..I Y="Y"  K BPPHARM( +P),BPPHAR M("B",$P(P ,U,2),+P)  ..S Y=P  ; Restore Or iginal Val ue ..K P . E  D ..;De fine new e ntries in  BPPHARM ar ray ..S BP PHARM(+Y)= Y ..S BPPH ARM("B",$P (Y,U,2),+Y )="" .; .; Display a  list of se lected div isions .I  $D(BPPHARM )>9 D ..N  X ..W !,?2 ,"Selected :" ..S X=" " F  S X=$ O(BPPHARM( "B",X)) Q: X=""  W !, ?10,X ..K  X .Q ;  K  BPPHARM("B ") Q Y
  653      
  654  
  655   If the use r has sele cted Speci fic Insura nce and th en doesn’t  make a se lection, m odify to r eturn the  user to th e ‘Select  Certain (I )NSURANCE  or (A)LL’  prompt.
  656  
  657   Subroutine  Name
  658   INSURSEL^B PSSCRCU
  659   Enhancemen t Category
  660    New
  661    Modify
  662    Delete
  663    No Change
  664   Current Lo gic
  665  
  666   BPSSCRCU ; BHAM ISC/S S - ECME S CREEN CONT INUOUS UPD ATE AND CH ANGE VIEW  ;05-APR-05  ;;1.0;E C LAIMS MGMT  ENGINE;** 1,5,7**;JU N 2004;Bui ld 46 ;;Pe r VHA Dire ctive 2004 -038, this  routine s hould not  be modifie d. Q ;
  667   . . . 
  668  
  669    ; Select  Insurance  using IB A PI - IA 47 21 ; Input : BPARR pa ssed by re f to store  user sele ction ; BP DUZ - User  DUZ ; Out put: RETV  = -1 if ti meout or u ser enters  "^" ; BPA RR(1.11)=" I" for ind ividual in surance or  "A" for a ll ; BPARR ("INS")=se mi-colon l ist of IEN s from fil e 36 if in dividual i nsurances  selected ;  Example o utput: BPA RR(1.11)=" I" BPARR(" INS")=";7; 499;200;"I NSURSEL(BP ARR,BPDUZ)  ; N RETV, BPQ,BPINP, BPINSARR,Y ,BPCNT S ( BPARR(1.11 ),BPARR(2. 04),BPARR( "INS"))=""  S (BPINS, BPCNT)=0 S  RETV=$$ED ITFLD^BPSS CRCV(1.11, +BPDUZ,"S^ I:SPECIFIC  INSURANCE (S);A:ALL" ,"Select C ertain (I) NSURANCE o r (A)LL)", "ALL",.BPA RR) ; Quit  if timeou t or ^ ent ered Q:RET V<0 +RETV  ; Quit if  ALL select ed Q:$P(RE TV,U,2)="A " +RETV ;  Get select ed insuran ces from p arameters  and displa y them I $ $GETINS(BP DUZ,.BPINS ARR) D DIS PINS(.BPIN SARR)
  670    ; Select  specific I nsurances  to add to  BPARR("INS ") array
  671    S BPQ=0 F   D  Q:BPQ ’=0 . S BP INP=$$SELI NSUR^IBNCP DPI("Selec t INSURANC E","") . S :+BPINP=-1  BPQ=-1 I  BPQ'=0 Q .  ; . ; Han dle delete s . I $D(B PINSARR(+B PINP)) D   Q . . W !  . . S Y=$$ PROMPT^BPS SCRCV("S^Y :YES;N:NO" ,"Delete " _$P(BPINP, U,2)_" fro m your lis t?","NO")  . . I Y="Y " K BPINSA RR(+BPINP) ,BPINSARR( "B",$P(BPI NP,U,2),+B PINP) . .  ; Display  a list of  selected I nsurance C ompanies .  . D DISPI NS(.BPINSA RR) . ; Sa ve selecti on in Insu rance Comp any array  . S BPINSA RR(+BPINP) =BPINP,BPI NSARR("B", $P(BPINP,U ,2),+BPINP )="" . ; D isplay a l ist of sel ected Insu rance Comp anies . D  DISPINS(.B PINSARR) ;  ;If the u ser entere d "^" Quit  returning  "^" I BPQ =-1,X="^"  Q "^" ;Che ck for bla nk entry,  if no prev ious selec tions prom pt user to  "Select I NSURANCE"  I BPQ=-1 I  $D(BPINSA RR)<9 G SE LINS1 ; ;  Save selec ted Insura nces in BP ARR("INS")  to be sav ed in inst ance 1.14  when filed . S BPARR( "INS")=""  F BPCNT=1: 1 S BPINS= $O(BPINSAR R(BPINS))  Q:+BPINS=0  D . S BPA RR("INS")= $G(BPARR(" INS"))_";" _BPINS S ( BPARR("INS "),BPARR(2 .04))=$G(B PARR("INS" ))_";" Q + RETV
  672  
  673   Modified L ogic (Chan ges are hi ghlighted)
  674  
  675   BPSSCRCU ; BHAM ISC/S S - ECME S CREEN CONT INUOUS UPD ATE AND CH ANGE VIEW  ;05-APR-05  ;;1.0;E C LAIMS MGMT  ENGINE;** 1,5,7,24** ;JUN 2004; Build 46 ; ;Per VA Di rective 64 022004-038 , this rou tine shoul d not be m odified. Q  ;
  676   . . . 
  677  
  678    ; Select  Insurance  using IB A PI - IA 47 21 ; Input : BPARR pa ssed by re f to store  user sele ction ; BP DUZ - User  DUZ ; Out put: RETV  = -1 if ti meout or u ser enters  "^" ; BPA RR(1.11)=" I" for ind ividual in surance or  "A" for a ll ; BPARR ("INS")=se mi-colon l ist of IEN s from fil e 36 if in dividual i nsurances  selected ;  Example o utput: BPA RR(1.11)=" I" BPARR(" INS")=";7; 499;200;"I NSURSEL(BP ARR,BPDUZ)  ; N RETV, BPQ,BPINP, BPINSARR,Y ,BPCNT S ( BPARR(1.11 ),BPARR(2. 04),BPARR( "INS"))=""  S (BPINS, BPCNT)=0 S  RETV=$$ED ITFLD^BPSS CRCV(1.11, +BPDUZ,"S^ I:SPECIFIC  INSURANCE (S);A:ALL" ,"Select C ertain (I) NSURANCE o r (A)LL)", "ALL",.BPA RR) ; Quit  if timeou t or ^ ent ered Q:RET V<0 +RETV  ; Quit if  ALL select ed Q:$P(RE TV,U,2)="A " +RETV ;  Get select ed insuran ces from p arameters  and displa y them I $ $GETINS(BP DUZ,.BPINS ARR) D DIS PINS(.BPIN SARR)SELIN S1 ; ; Sel ect specif ic Insuran ces to add  to BPARR( "INS") arr ay S BPQ=0  F  D  Q:B PQ’=0 . S  BPINP=$$SE LINSUR^IBN CPDPI("Sel ect INSURA NCE","") .  S:+BPINP= -1 BPQ=-1  I BPQ'=0 Q   . ; . ;  Handle del etes . I $ D(BPINSARR (+BPINP))  D  Q . . W  ! . . S Y =$$PROMPT^ BPSSCRCV(" S^Y:YES;N: NO","Delet e "_$P(BPI NP,U,2)_"  from your  list?","NO ") . . I Y ="Y" K BPI NSARR(+BPI NP),BPINSA RR("B",$P( BPINP,U,2) ,+BPINP) .  . ; Displ ay a list  of selecte d Insuranc e Companie s . . D DI SPINS(.BPI NSARR) . ;  Save sele ction in I nsurance C ompany arr ay . S BPI NSARR(+BPI NP)=BPINP, BPINSARR(" B",$P(BPIN P,U,2),+BP INP)="" .  ; Display  a list of  selected I nsurance C ompanies .  D DISPINS (.BPINSARR ) ; ;If th e user ent ered "^" Q uit return ing "^" I  BPQ=-1,X=" ^" Q "^" ;  ; Save se lected Ins urances in  BPARR("IN S") to be  saved in i nstance 1. 14 when fi led. S BPA RR("INS")= "" F BPCNT =1:1 S BPI NS=$O(BPIN SARR(BPINS )) Q:+BPIN S=0 D . S  BPARR("INS ")=$G(BPAR R("INS"))_ ";"_BPINS  S (BPARR(" INS"),BPAR R(2.04))=$ G(BPARR("I NS"))_";"  Q +RETV
  679      
  680  
  681   The filter  prompts f or Drug, D rug Class  and Patien t all call  the subro utine SEL^ BPSRPT3A w hen making  a selecti on. Modify  SEL^BPSRP T3A so it  requires t he user to  make an e ntry.
  682  
  683   Subroutine  Name
  684   SEL^BPSRPT 3A
  685   Enhancemen t Category
  686    New
  687    Modify
  688    Delete
  689    No Change
  690   Current Lo gic
  691  
  692   SEL(FIELD, FILE,BPSAR RAY,DEFAUL T) ; ; Pro vides fiel d selectio n for One  or More N  DIC,DTOUT, DUOUT,QT,Y ,X N BPSAR R ; S DIC= FILE,DIC(0 )="QEZAM", DIC("A")=" Select "_F IELD_": "  I $G(DEFAU LT)'="" S  DIC("B")=D EFAULT F   D ^DIC Q:X =""  D  Q: $G(QT) . ;  Check for  "^" or ti meout, if  found set  BPSARRAY=" ^" and qui t. . I $D( DTOUT)!$D( DUOUT) K B PSARRAY S  BPSARRAY=" ^",QT=1 Q  . ; . ; If  selection  already e xists in B PSARRAY, t hen displa y message  . ; "(alre ady select ed)" and p rompt for  next selec tion. . I  $D(BPSARRA Y(+Y)) W "  (already  selected)"  . S BPSAR RAY(+Y)=$P (Y,"^",2)  . W " ",$P (Y,"^",2), ! . ; . S  DIC("A")=" Select "_F IELD_": "  . ; . ; di splay a li st of curr ent select ions . I F IELD="Drug  Class" D  . . S BPSA RR="" . .  F  S BPSAR R=$O(BPSAR RAY(BPSARR )) Q:'BPSA RR  I BPSA RR'=+Y W ? 3,$$GET1^D IQ(50.605, BPSARR,1), " ",$$GET1 ^DIQ(50.60 5,BPSARR,. 01),! . ;  . I $D(BPS ARRAY),FIE LD'="Drug  Class" D .  . S BPSAR R="" F  S  BPSARR=$O( BPSARRAY(B PSARR)) Q: 'BPSARR  W  ?10,BPSAR RAY(BPSARR ),! . K DI C("B") ; ;  If nothin g was sele cted set B PSARRAY=0  I '$D(BPSA RRAY) S BP SARRAY=0 Q  ;
  693  
  694   Modified L ogic (Chan ges are hi ghlighted)
  695  
  696   SEL(FIELD, FILE,BPSAR RAY,DEFAUL T) ; ; Pro vides fiel d selectio n for One  or More N  DIC,DTOUT, DUOUT,QT,Y ,X N BPSAR R ; S DIC= FILE,DIC(0 )="QEZAM", DIC("A")=" Select "_F IELD_": "  I $G(DEFAU LT)'="" S  DIC("B")=D EFAULT
  697    ; F  D ^D IC Q:X=""   D  Q:$G(Q T) . ; Che ck for "^"  or timeou t, if foun d set BPSA RRAY="^" a nd quit. .  I $D(DTOU T)!$D(DUOU T) K BPSAR RAY S BPSA RRAY="^",Q T=1 Q . ;  . ; If sel ection alr eady exist s in BPSAR RAY, then  display me ssage . ;  "(already  selected)"  and promp t for next  selection . . I $D(B PSARRAY(+Y )) W " (al ready sele cted)" . S  BPSARRAY( +Y)=$P(Y," ^",2) . W  " ",$P(Y," ^",2),! .  ; . S DIC( "A")="Sele ct "_FIELD _": " . ;  . ; displa y a list o f current  selections  . I FIELD ="Drug Cla ss" D . .  S BPSARR=" " . . F  S  BPSARR=$O (BPSARRAY( BPSARR)) Q :'BPSARR   I BPSARR'= +Y W ?3,$$ GET1^DIQ(5 0.605,BPSA RR,1)," ", $$GET1^DIQ (50.605,BP SARR,.01), ! . ; . I  $D(BPSARRA Y),FIELD'= "Drug Clas s" D . . S  BPSARR=""  F  S BPSA RR=$O(BPSA RRAY(BPSAR R)) Q:'BPS ARR  W ?10 ,BPSARRAY( BPSARR),!  . K DIC("B ") ; ; If  nothing wa s selected  set BPSAR RAY=0 I '$ D(BPSARRAY ) S BPSARR AY=0 Q ;
  698      
  699  
  700   In the Dru g, Drug Cl ass and Pa tient filt er prompts  remove th e logic th at returns  the user  to the men u if no se lection wa s made.
  701  
  702   Subroutine  Name
  703   SELDRG1^BP SRPT3A
  704   Enhancemen t Category
  705    New
  706    Modify
  707    Delete
  708    No Change
  709   Current Lo gic
  710  
  711   SELDRG1()  ; ; ; Allo w user to  select a s ingle or m ultiple DR UGS. ; ; T he users s election i s stored i n BPARR("D RUG") sepa rated by a  comma. ;  BPARR("DRU G")=drug i en1,drug i en2 ;DRG1  ; N BPARR, BPSIEN,BPS DRGARR S B PARR("DRUG ")="" ; ;  The SEL ta g prompts  user to 'S elect Drug ' and vali dates the  selection  against th e DRUG fil e. D SEL(" Drug","^PS DRUG(",.BP SDRGARR) ;  ; If the  user enter ed "^" qui t, no long er prompti ng the use r to 'Sele ct Drug' I  $G(BPSDRG ARR)="^" Q  "^" ; ; I f no drug  was select ed, return  "^" so th e user wil l return t o the menu  I $G(BPSD RGARR)=0 Q  "^" ; M B PARR("DRUG ")=BPSDRGA RR ; ; Cre ates a str ing of all  the drug  ien's sele cted separ ated by a  comma. S B PSIEN="" F   S BPSIEN =$O(BPARR( "DRUG",BPS IEN)) Q:BP SIEN=""  D  . I BPARR ("DRUG")'= "" S BPARR ("DRUG")=B PARR("DRUG ")_"," . S  BPARR("DR UG")=BPARR ("DRUG")_B PSIEN . Q  ; Q BPARR( "DRUG")
  712  
  713   Modified L ogic (Chan ges are hi ghlighted)
  714  
  715   SELDRG1()  ; ; ; Allo w user to  select a s ingle or m ultiple DR UGS. ; ; T he users s election i s stored i n BPARR("D RUG") sepa rated by a  comma. ;  BPARR("DRU G")=drug i en1,drug i en2 ;DRG1  ; N BPARR, BPSIEN,BPS DRGARR S B PARR("DRUG ")="" ; ;  The SEL ta g prompts  user to 'S elect Drug ' and vali dates the  selection  against th e DRUG fil e. D SEL(" Drug","^PS DRUG(",.BP SDRGARR) ;  ; If the  user enter ed "^" qui t, no long er prompti ng the use r to 'Sele ct Drug' I  $G(BPSDRG ARR)="^" Q  "^" ; ; I f no drug  was select ed, return  "0^" so t he user wi ll returne d to the D rug or Dru g Class or  All promp t.to the m enu I $G(B PSDRGARR)= 0 Q 0"^" ;  M BPARR(" DRUG")=BPS DRGARR ; ;  Creates a  string of  all the d rug ien's  selected s eparated b y a comma.  S BPSIEN= "" F  S BP SIEN=$O(BP ARR("DRUG" ,BPSIEN))  Q:BPSIEN=" "  D . I B PARR("DRUG ")'="" S B PARR("DRUG ")=BPARR(" DRUG")_","  . S BPARR ("DRUG")=B PARR("DRUG ")_BPSIEN  . Q ; Q BP ARR("DRUG" )
  716  
  717  
  718   Subroutine  Name
  719   SELDC^BPSR PT3A
  720   Enhancemen t Category
  721    New
  722    Modify
  723    Delete
  724    No Change
  725   Current Lo gic
  726  
  727   SELDC() ;  ; ; Allow  user to se lect a sin gle or mul tiple DRUG  CLASSes,  ; ; The us ers select ion is sto red in BPA RR("DRUG C LASS") sep arated by  a semi col on. ; BPAR R("DRUG CL ASS")=dc n ame ien ;  dc name ie n ;DRGCL ;  N BPARR,B PSIEN,BPSD CARR S BPA RR("DRUG C LASS")=""  ; ; The SE L tag prom pts user a nd validat es the sel ection aga inst the D RUG CLASS  file. D SE L("Drug Cl ass","^PS( 50.605,",. BPSDCARR)  ; ; If the  user ente red "^" qu it, no lon ger prompt ing the us er to 'Sel ect Drug C lass' I $G (BPSDCARR) ="^" Q "^"  ; ; If no  drug was  selected,  return "^"  so the us er will re turn to th e menu I $ G(BPSDCARR )=0 Q "^"  ; M BPARR( "DRUG CLAS S")=BPSDCA RR ; ; Cre ates a str ing of all  the drug  class ien' s selected  separated  by a comm a.  S BPSI EN="" F  S  BPSIEN=$O (BPARR("DR UG CLASS", BPSIEN)) Q :BPSIEN=""   D . I BP ARR("DRUG  CLASS")'=" " S BPARR( "DRUG CLAS S")=BPARR( "DRUG CLAS S")_";" .  S BPARR("D RUG CLASS" )=BPARR("D RUG CLASS" )_$$GET1^D IQ(50.605, BPSIEN,1)  . Q ; Q BP ARR("DRUG  CLASS")
  728  
  729   Modified L ogic (Chan ges are hi ghlighted)
  730  
  731   SELDC() ;  ; ; Allow  user to se lect a sin gle or mul tiple DRUG  CLASSes,  ; ; The us ers select ion is sto red in BPA RR("DRUG C LASS") sep arated by  a semi col on. ; BPAR R("DRUG CL ASS")=dc n ame ien ;  dc name ie n ;DRGCL ;  N BPARR,B PSIEN,BPSD CARR S BPA RR("DRUG C LASS")=""  ; ; The SE L tag prom pts user a nd validat es the sel ection aga inst the D RUG CLASS  file. D SE L("Drug Cl ass","^PS( 50.605,",. BPSDCARR)  ; ; If the  user ente red "^" qu it, no lon ger prompt ing the us er to 'Sel ect Drug C lass' I $G (BPSDCARR) ="^" Q "^"  ; ; If no  drug was  selected,  return "0^ " so the u ser will r eturned to  the Drug  or Drug Cl ass or All  prompt.to  the menu  I $G(BPSDC ARR)=0 Q 0 "^" ; M BP ARR("DRUG  CLASS")=BP SDCARR ; ;  Creates a  string of  all the d rug class  ien's sele cted separ ated by a  comma.  S  BPSIEN=""  F  S BPSIE N=$O(BPARR ("DRUG CLA SS",BPSIEN )) Q:BPSIE N=""  D .  I BPARR("D RUG CLASS" )'="" S BP ARR("DRUG  CLASS")=BP ARR("DRUG  CLASS")_"; " . S BPAR R("DRUG CL ASS")=BPAR R("DRUG CL ASS")_$$GE T1^DIQ(50. 605,BPSIEN ,1) . Q ;  Q BPARR("D RUG CLASS" )
  732      
  733  
  734   Subroutine  Name
  735   SELPAT^BPS RPT3A
  736   Enhancemen t Category
  737    New
  738    Modify
  739    Delete
  740    No Change
  741   Current Lo gic
  742  
  743   SELPAT() ;  ; Allow u ser to sel ect a sing le or mult iple PATIE NT(s). ; ;  If the us ers select ed one or  more PATIE NTs, the s election w ill be sto red ; in B PARR("PATI ENT")separ ated by a  comma. e.g . BPARR("P ATIENT")=  patient ie n1 , patie nt ien2 ;B PPAT ; N D IR,DIRUT,D TOUT,DUOUT ,X,Y N BPA RR,BPSARRA Y,BPSIEN ;  S BPARR(" PATIENT")= "" ; ; The  SEL tag p rompts use r to 'Sele ct Patient ' and vali dates the  selection  against th e PATIENT  file. D SE L("Patient ","^DPT(", .BPSARRAY)  ; ; If th e user ent ered "^" q uit, no lo nger promp ting the u ser to 'Se lect Patie nt' I $G(B PSARRAY)=" ^" Q "^" ;  ; If no P atient was  selected,  return "^ " so the u ser will r eturn to t he menu  I  $G(BPSARR AY)=0 Q "^ " ; M BPAR R("PATIENT ")=BPSARRA Y ; ; Crea tes a stri ng of all  the patien t ien's se lected sep arated by  a comma. S  BPSIEN=""  F  S BPSI EN=$O(BPAR R("PATIENT ",BPSIEN))  Q:BPSIEN= ""  D . I  BPARR("PAT IENT")'=""  S BPARR(" PATIENT")= BPARR("PAT IENT")_","  . S BPARR ("PATIENT" )=BPARR("P ATIENT")_B PSIEN . Q  ; Q BPARR( "PATIENT")
  744  
  745   Modified L ogic (Chan ges are hi ghlighted)
  746  
  747   SELPAT() ;  ; Allow u ser to sel ect a sing le or mult iple PATIE NT(s). ; ;  If the us ers select ed one or  more PATIE NTs, the s election w ill be sto red ; in B PARR("PATI ENT")separ ated by a  comma. e.g . BPARR("P ATIENT")=  patient ie n1 , patie nt ien2 ;B PPAT ; N D IR,DIRUT,D TOUT,DUOUT ,X,Y N BPA RR,BPSARRA Y,BPSIEN ;  S BPARR(" PATIENT")= "" ; ; The  SEL tag p rompts use r to 'Sele ct Patient ' and vali dates the  selection  against th e PATIENT  file. D SE L("Patient ","^DPT(", .BPSARRAY)  ; ; If th e user ent ered "^" q uit, no lo nger promp ting the u ser to 'Se lect Patie nt' I $G(B PSARRAY)=" ^" Q "^" ;  ; If no P atient was  selected,  return th e user to  'Display S elected (P )atient or  (A)LL'"^"  so the us er will re turn to th e menu  I  $G(BPSARRA Y)=0 Q 0"^ " ; M BPAR R("PATIENT ")=BPSARRA Y ; ; Crea tes a stri ng of all  the patien t ien's se lected sep arated by  a comma. S  BPSIEN=""  F  S BPSI EN=$O(BPAR R("PATIENT ",BPSIEN))  Q:BPSIEN= ""  D . I  BPARR("PAT IENT")'=""  S BPARR(" PATIENT")= BPARR("PAT IENT")_","  . S BPARR ("PATIENT" )=BPARR("P ATIENT")_B PSIEN . Q  ; Q BPARR( "PATIENT")
  748      
  749  
  750  
  751  
  752   Modify the  subroutin e to allow  the user  to select  one, multi ple or all  Closed Cl aim Reason s. Multipl e selectio ns will be  returned  in a strin g separate d by a com ma.
  753     
  754   Subroutine  Name
  755   SELCCRSN^B PSRPT4
  756   Enhancemen t Category
  757    New
  758    Modify
  759    Delete
  760    No Change
  761   Current Lo gic
  762  
  763    ; Select  to Include  (S)pecifi c Close Cl aim Reason  or (A)ll
  764    ;
  765    ; Input V ariable ->  DFLT = 1  Specific C LAIMS TRAC KING NON-B ILLABLE RE ASONS
  766    ;                            0  All Reason s
  767    ;                            
  768    ; Return  Value ->    ptr = poi nter to CL AIMS TRACK ING NON-BI LLABLE REA SONS (#356 .8)
  769    ;                       0 = All  Reasons
  770    ;                       ^ = Exi t
  771    ;
  772   SELCCRSN(D FLT) N DIC ,DIR,DIRUT ,DUOUT,RSN ,X,Y
  773    ;
  774    S DFLT=$S ($G(DFLT)= 1:"Specifi c Close Cl aim Reason ",1:"ALL")
  775    S DIR(0)= "S^S:Speci fic Close  Claim Reas on;A:ALL"
  776    S DIR("A" )="Include  (S)pecifi c Close Cl aim Reason  or (A)LL" ,DIR("B")= DFLT
  777    D ^DIR
  778    I ($G(DUO UT)=1)!($G (DTOUT)=1)  S Y="^"
  779    S RSN=$S( Y="S":1,Y= "A":0,1:Y)
  780    ;
  781    ;Check fo r "^" or t imeout
  782    I ($G(DUO UT)=1)!($G (DTOUT)=1)  S (RSN,Y) ="^"
  783    ;
  784    ;If Speci fic Reject  Code sele cted, ask  prompt
  785    I $G(RSN) =1 D
  786    .;
  787    .;Prompt  for entry
  788    .K X S DI C(0)="QEAM ",DIC=356. 8,DIC("A") ="Select C lose Claim  Reason: "
  789    .W ! D ^D IC
  790    .;
  791    .;Check f or "^", ti meout, or  blank entr y
  792    .I ($G(DU OUT)=1)!($ G(DTOUT)=1 )!($G(X)=" ") S (RSN, Y)="^" Q
  793    .;
  794    .;If vali d entry, s etup RSN
  795    .I +Y>0 S  RSN=+Y
  796    ;
  797    Q RSN
  798  
  799   Modified L ogic (Chan ges are hi ghlighted)
  800  
  801    ; Select  to Include  (S)pecifi c Close Cl aim Reason  or (A)ll
  802    ;
  803    ; Input V ariable ->  DFLT = 1  Specific C LAIMS TRAC KING NON-B ILLABLE RE ASONS
  804    ;                            0  All Reason s
  805    ;                            
  806    ; Return  Value ->       0 = Al l Reasons
  807    ;                        ^ = Ex it
  808    ;                 pt r,ptr = co mma delimi ted string  of pointe rs to CLAI MS
  809    ;                             T RACKING NO N-BILLABLE  REASONS ( #356.8)
  810    ;
  811   SELCCRSN(D FLT) ;N DI C,DIR,DIRU T,DUOUT,RS N,X,Y
  812    N ARR,BPS ARRAY,BPSC CR,DIC,DIR ,DIRUT,DTO UT,DUOUT,R SN,X,Y
  813    ;
  814    S DFLT=$S ($G(DFLT)= 1:"Specifi c Close Cl aim Reason ",1:"ALL")
  815    S DIR(0)= "S^S:Speci fic Close  Claim Reas on;A:ALL"
  816    S DIR("A" )="Include  (S)pecifi c Close Cl aim Reason  or (A)LL" ,DIR("B")= DFLT
  817    D ^DIR
  818    I ($G(DUO UT)=1)!($G (DTOUT)=1)  S Y="^"
  819    S RSN=$S( Y="S":1,Y= "A":0,1:Y)
  820    ;
  821    ;Check fo r "^" or t imeout
  822    I ($G(DUO UT)=1)!($G (DTOUT)=1)  S (RSN,Y) ="^"
  823    ;
  824    ;If Speci fic Reject  Code sele cted, ask  prompt
  825    I $G(RSN) =1 D
  826    .;
  827    .;Prompt  for entry
  828    .K X S DI C(0)="QEAM ",DIC=356. 8,DIC("A") ="Select C lose Claim  Reason: "
  829    .W ! D ^D IC
  830    .;
  831    .;Check f or "^", ti meout, or  blank entr y
  832    .I ($G(DU OUT)=1)!($ G(DTOUT)=1 )!($G(X)=" ") S (RSN, Y)="^" Q
  833    .;
  834    .;If vali d entry, s etup RSN
  835    .I +Y>0 S  RSN=+Y
  836    ;
  837    Q RSN
  838    ;
  839    ; ALL - B PSCCR=0 /  Specific C lose Claim  Reason -  BPSCCR=1 S  BPSCCR=$S (Y="S":1,Y ="A":0,1:Y )
  840    ; ;If "^"  was enter ed or ther e was a Ti meout, ret urn "^" I  ($G(DUOUT) =1)!($G(DT OUT)=1) S  (RSN,Y)="^ " ; Q:BPSC CR'=1 BPSC CR W ! ;
  841    N DIC,DIR UT,DTOUT,D UOUT,X,Y
  842    ;
  843   BPSCCR ; ; User selec ted (S)pec ific Close  Claim Rea son, allow  user to s elect one  or multipl e reasons.  S DIC(0)= "QEAM",DIC =356.8,DIC ("A")="Sel ect Close  Claim Reas on: "
  844    F  D ^DIC  Q:X=""  D   Q:$G(BPS ARRAY)="^"  . ; Check  for "^" o r a timeou t, if foun d set BPSA RRAY="^" a nd quit. .  I $D(DUOU T)!$D(DTOU T)!($D(DIR UT)) S BPS ARRAY="^"  Q . ; . ;  Add select ion to BPS ARRAY and  display cl ose claim  reason. .  S BPSARRAY (+Y)=$P(Y, U,2) . W "  ",$P(Y,"^ ",2),!  .  ; . ; Disp lay a list  of curren t selectio ns. . S AR R="" F  S  ARR=$O(BPS ARRAY(ARR) ) Q:'ARR   W ?10,BPSA RRAY(ARR), ! ; ; If B PSARRAY="^ " quit and  return "^ ". I $G(BP SARRAY)="^ " Q "^"
  845    ; ; If no thing was  selected q uit and re turn "". I  '$D(BPSAR RAY) Q ""  ; ; If not hing was s elected, r e-prompt f or selecti on. I '$D( BPSARRAY)  G BPSCCR ;  ; Create  a comma de limited st ring BPSCC R that con tains the  selected c lose claim  reason ie n's. S BPS CCR="" S A RR="" F  S  ARR=$O(BP SARRAY(ARR )) Q:'ARR   S BPSCCR= BPSCCR_ARR _"," ; Q B PSCCR ;
  846  
  847  
  848  
  849   Modify the  subroutin e to allow  for multi ple user s elections  and for Dr ug, Eligib ility, Clo sed Claim  Reason and  Patient.   The Fill  Type, Fill  Location,  Drug Clas s and Bill ed Amount  were modif ied as par t of US572  and don’t  require a ny additio nal change s.  This s ubroutine  loops thro ugh the BP S TRANSACT ION file a nd checks  to see if  the transa ction meet s the crit eria that  the user s elected.
  850  
  851  
  852   Subroutine  Name
  853   PROCESS^BP SRPT1
  854   Enhancemen t Category
  855    New
  856    Modify
  857    Delete
  858    No Change
  859   Current Lo gic
  860  
  861   PROCESS(BP 59) ;
  862    N BPBILLE D,BPBCK,BP BCKX,BPDFN ,BPREF,BPP AYBL,BPPLA N,BPREJ,BP RLSDT,BPRX ,BPRXDRG,B PSTATUS,BP SEQ,BPSTOP  ;
  863   ...
  864  
  865    ; ;If Tot als by Dat e, include  only reje cts and pa yables I B PRTYPE=6,B PSTATUS'[" REJECTED", BPSTATUS'[ "PAYABLE"  G XPROC  ;  Reversed  ; ;Realtim e/Backbill /PRO Optio n/Resubmis sion Check  S BPBCK=$ $RTBCK(BP5 9) ; ; BPB CK = 1 Bac kbill / 2  PRO / 5 Re sub / 0 Re altime ; B PRTBCK = 3  Backbill  / 4 PRO /  5 Resub /  2 Realtime  ; S BPBCK X=$S(BPBCK =1:3,BPBCK =2:4,BPBCK =5:5,BPBCK =0:2,1:"")  ;convert  to BPRTBCK  value ; ;  If user d oesn't wan t all tran smission t ypes (BPRT BCK'=1), ;  then figu re out if  this trans action is  OK I BPRTB CK'=1,BPRT BCK'[BPBCK X G XPROC  ; ;Check f or MAIL/WI NDOW/CMOP/ ALL I BPMW C'="A",BPM WC'[$$MWC^ BPSRPT6(BP RX,BPREF)  G XPROC ;  ;Check for  selected  insurance  S BPPLAN=$ $INSNAM^BP SRPT6(BP59 ) I BPINSI NF'=0,'$$C HKINS^BPSS CRCU($P(BP PLAN,U,1), BPINSINF)  G XPROC S  BPPLAN=$P( BPPLAN,U,2 ) ; ;Check  for selec ted drug S  BPRXDRG=$ $GETDRUG^B PSRPT6(BPR X) I BPRXD RG=0 G XPR OC I BPDRU G,BPDRUG'[ BPRXDRG G  XPROC ; ;C heck for s elected dr ug classes  I BPDRGCL '=0 S BPRX DC=$$DRGCL NAM^BPSRPT 6($$GETDRG CL^BPSRPT6 (BPRXDRG), 99) D  I B PSTOP=0 G  XPROC . S  BPSTOP=0 .  F I=1:1:$ L(BPDRGCL, ";") I BPR XDC=$P(BPD RGCL,";",I ) S BPSTOP =1 Q ;
  866    ;Check fo r selected  Close Rea son I BPCC RSN,BPCCRS N'=$P($$CL RSN^BPSRPT 7(BP59),U)  G XPROC ;  ;Check fo r Accepted /Rejected  I BPACREJ= 1,BPSTATUS '["REJECTE D" G XPROC  I BPACREJ =2,BPSTATU S'["ACCEPT ED" G XPRO C ; ;Check  for Speci fic Reject  Code I BP REJCD'=0 D   I BPSTOP =0 G XPROC  . S BPSTO P=0 . F I= 1:1:($L(BP REJCD,",") -1) I $$CK REJ(BP59,$ P(BPREJCD, ",",I)) S  BPSTOP=1 Q  ;
  867    ;Check fo r Eligibil ity Code I  BPELIG'=0 ,BPELIG'=$ $ELIGCODE^ BPSSCR05(B P59) G XPR OC ;
  868    ;Check fo r Eligibil ity Codes,  when one  or more is  selected  (BPELIG1=1 )
  869    I (",2,") [BPRTYPE,B PELIG1’=0  S ELIG=$$E LIGCODE^BP SSCR05(BP5 9) I ‘$D(B PELIG1(ELI G)) G XPRO C
  870    ;
  871    ;Check fo r selected  Prescribe rs
  872    I BPRESC’ =0 D  I BP STOP=0 G X PROC
  873    . S BPSTO P=0
  874    . F I=1:1 :$L(BPRESC ,",")-1 I  $$CKPRESC( BP59,$P(BP RESC,",",I )) S BPSTO P=1 Q
  875    ;
  876    ;Check fo r selected  Patients
  877    I BPQSTPA T'=0,$G(BP PAT)'="" D   I BPSTOP =0 G XPROC  . S BPSTO P=0 . F I= 1:1:$L(BPP AT,",") I  $P(BPPAT,I )[$$GET1^D IQ(9002313 .59,BP59,5 ,"I") S BP STOP=1 Q
  878    ;
  879    ; Check f or Billed  Amount
  880    I $G(BPBI LL)’=0 S B PBILLED=$$ GET1^DIQ(9 002313.59, BP59,505)  I (BPBILLE D<BPMIN)!( BPBILLED>B PMAX) G XP ROC
  881    ;
  882    ;Check Op en/Closed  claim I BP OPCL'=0,(( BPOPCL=2)& ($$CLOSED0 2^BPSSCR03 ($P(^BPST( BP59,0),U, 4))=1))!(( BPOPCL=1)& ($$CLOSED0 2^BPSSCR03 ($P(^BPST( BP59,0),U, 4))'=1)) G  XPROC ; ; Save Entry  for Repor t D SETTMP ^BPSRPT2(B PGLTMP,BPD FN,BPRX,BP REF,BP59,B PBEGDT,BPE NDDT,.BPPH ARM,BPSUMD ET,BPPLAN, BPRLSDT,BP PAYBL,BPRE J,BPRXDRG, $P(BPSTATU S,U)) ;XPR OC Q
  883  
  884   Modified L ogic (Chan ges are hi ghlighted)
  885  
  886   PROCESS(BP 59) ;
  887    N BPBILLE D,BPBCK,BP BCKX,BPDFN ,BPREF,BPP AYBL,BPPLA N,BPREJ,BP RLSDT,BPRX ,BPRXDRG,B PSTATUS,BP SEQ,BPSTOP  ;
  888   ...
  889    ; ;If Tot als by Dat e, include  only reje cts and pa yables I B PRTYPE=6,B PSTATUS'[" REJECTED", BPSTATUS'[ "PAYABLE"  G XPROC  ;  Reversed  ; ;Realtim e/Backbill /PRO Optio n/Resubmis sion Check  S BPBCK=$ $RTBCK(BP5 9) ; ; BPB CK = 1 Bac kbill / 2  PRO / 5 Re sub / 0 Re altime ; B PRTBCK = 3  Backbill  / 4 PRO /  5 Resub /  2 Realtime  ; S BPBCK X=$S(BPBCK =1:3,BPBCK =2:4,BPBCK =5:5,BPBCK =0:2,1:"")  ;convert  to BPRTBCK  value ; ;  If user d oesn't wan t all tran smission t ypes (BPRT BCK'=1), ;  then figu re out if  this trans action is  OK I BPRTB CK'=1,BPRT BCK'[BPBCK X G XPROC  ; ;Check f or MAIL/WI NDOW/CMOP/ ALL I BPMW C'="A",BPM WC'[$$MWC^ BPSRPT6(BP RX,BPREF)  G XPROC ;  ;Check for  selected  insurance  S BPPLAN=$ $INSNAM^BP SRPT6(BP59 ) I BPINSI NF'=0,'$$C HKINS^BPSS CRCU($P(BP PLAN,U,1), BPINSINF)  G XPROC S  BPPLAN=$P( BPPLAN,U,2 ) ; ;Check  for selec ted drug S  BPRXDRG=$ $GETDRUG^B PSRPT6(BPR X) I BPRXD RG=0 G XPR OC
  890    I BPDRUG, BPDRUG'[BP RXDRG G XP ROC
  891    I BPDRUG  D  I BPSTO P=0 G XPRO C . S BPST OP=0 . F I =1:1:$L(BP DRUG,",")  I BPRXDRG= $P(BPDRUG, ",",I) S B PSTOP=1 Q  ; ;Check f or selecte d drug cla sses I BPD RGCL'=0 S  BPRXDC=$$D RGCLNAM^BP SRPT6($$GE TDRGCL^BPS RPT6(BPRXD RG),99) D   I BPSTOP= 0 G XPROC  . S BPSTOP =0 . F I=1 :1:$L(BPDR GCL,";") I  BPRXDC=$P (BPDRGCL," ;",I) S BP STOP=1 Q ;
  892    ;Check fo r selected  Close Rea son I BPCC RSN D  I B PSTOP=0 G  XPROC
  893    . S BPSTO P=0
  894    . F I=1:1 :$L(BPCCRS N,",")-1 I  $P(BPCCRS N,",",I)=$ P($$CLRSN^ BPSRPT7(BP 59),U) S B PSTOP=1 Q
  895    ; ;Check  for Accept ed/Rejecte d I BPACRE J=1,BPSTAT US'["REJEC TED" G XPR OC I BPACR EJ=2,BPSTA TUS'["ACCE PTED" G XP ROC ; ;Che ck for Spe cific Reje ct Code I  BPREJCD'=0  D  I BPST OP=0 G XPR OC . S BPS TOP=0 . F  I=1:1:($L( BPREJCD,", ")-1) I $$ CKREJ(BP59 ,$P(BPREJC D,",",I))  S BPSTOP=1  Q ; ;;Che ck for Eli gibility C ode ;;I BP ELIG'=0,BP ELIG'=$$EL IGCODE^BPS SCR05(BP59 ) G XPROC  ;
  896    ;Check fo r Eligibil ity Codes,  when one  or more is  selected  (BPELIG1=1 )
  897    I (",1,2, 3,4,7,9,") [BPRTYPE,B PELIG1’=0  S ELIG=$$E LIGCODE^BP SSCR05(BP5 9) G:$G(EL IG)="" XPR OC I '$D(B PELIG1(ELI G)) G XPRO C
  898    ;
  899    ;Check fo r selected  Prescribe rs
  900    I BPRESC’ ="^",BPRES C’=1 D  I  BPSTOP=0 G  XPROC
  901    . S BPSTO P=0
  902    . F I=1:1 :$L(BPRESC ,",")-1 I  $$CKPRESC( BP59,$P(BP RESC,",",I )) S BPSTO P=1 Q
  903    ;
  904    ;Check fo r selected  Patients
  905    I BPQSTPA T'=0,$G(BP PAT)'="" D   I BPSTOP =0 G XPROC  . S BPSTO P=0 . F I= 1:1:$L(BPP AT,",") I  $P(BPPAT,I )[=$$GET1^ DIQ(900231 3.59,BP59, 5,"I") S B PSTOP=1 Q
  906    ;
  907    ; Check f or Billed  Amount
  908    I $G(BPBI LL)’=0 S B PBILLED=$$ GET1^DIQ(9 002313.59, BP59,505)  I (BPBILLE D<BPMIN)!( BPBILLED>B PMAX) G XP ROC
  909    ;
  910    ;Check Op en/Closed  claim I BP OPCL'=0,(( BPOPCL=2)& ($$CLOSED0 2^BPSSCR03 ($P(^BPST( BP59,0),U, 4))=1))!(( BPOPCL=1)& ($$CLOSED0 2^BPSSCR03 ($P(^BPST( BP59,0),U, 4))'=1)) G  XPROC ; ; Save Entry  for Repor t D SETTMP ^BPSRPT2(B PGLTMP,BPD FN,BPRX,BP REF,BP59,B PBEGDT,BPE NDDT,.BPPH ARM,BPSUMD ET,BPPLAN, BPRLSDT,BP PAYBL,BPRE J,BPRXDRG, $P(BPSTATU S,U)) ;XPR OC Q
  911  
  912  
  913   Two subrou tines will  need to b e modified  for the N on-Billabl e Status R eport to c heck to se e if the t ransaction  meets the  criteria  that the u ser select ed.  $$COL LECT^BPSRP T1 will be  modified  to send ad ditional f ields from  the new p rompts add ed to $$CO LLECT^IBNC PEV3 where  the crite ria will b e checked.
  914  
  915   Subroutine  Name
  916   $$COLLECT^ BPSRPT1
  917   Enhancemen t Category
  918    New
  919    Modify
  920    Delete
  921    No Change
  922   Current Lo gic
  923  
  924   COLLECT(BP GLTMP) N B P02,BP57,B P59,BPENDD T1,BPLDT02 ,BPLDT57,X ,Y,OK,BPIX
  925    ;
  926    ;Check Va riables
  927    S OK=1
  928    S:'$G(BPB EGDT) BPBE GDT=0
  929    S:'$G(BPE NDDT) BPEN DDT=999999 9
  930    S BPENDDT =BPENDDT+0 .9
  931    I $G(BPRT YPE)=""!($ G(BPGLTMP) ="")!($G(B PPHARM)="" )!($G(BPSU MDET)="")! ($G(BPINSI NF)="")!($ G(BPMWC)=" ")!($G(BPR TBCK)="")  S OK=-1 G  EXIT
  932    ;
  933    ; For the  Non-Billa ble Status  report, w e need to  loop throu gh the IB  NCPDP EVEN T LOG inst ead 
  934    ;   of BP S Claim/BP S Transact ion data
  935    I BPRTYPE =9 Q $$COL LECT^IBNCP EV3(BPBEGD T,BPENDDT, BPMWC,BPRL NRL,BPDRUG ,BPDRGCL,B PALRC,.BPP HARM,.BPIN SINF,.BPNB STS,.BPELI G1,BPGLTMP )
  936    ;
  937    ;Loop thr ough BPS C LAIMS
  938    ;
  939    ;First lo ok for fil l/refill c ross refer ence
  940    ;Loop thr ough Date  of Service  Index in  BPS CLAIMS  file and  find link  to 
  941    ;claim in  BPS TRANS ACTION.  P rocess ear liest Date  of Servic e entry fo und in
  942    ;BPS TRAN SACTION
  943    ;
  944    ;Choose I ndex to Lo op through  (differen t for Clos ed Claims)
  945    S BPIX="A F" S:BPRTY PE=7 BPIX= "AG"
  946    ;
  947    S BPLDT02 =$S(BPIX=" AF":$$FM2Y MD(BPBEGDT -0.00001), 1:BPBEGDT)  S:BPLDT02 ="" BPLDT0 2=0
  948    S BPENDDT 1=$S(BPIX= "AF":$$FM2 YMD(BPENDD T),1:BPEND DT_".99999 99999") S: BPENDDT1=" " BPENDDT1 =99999999
  949    F  S BPLD T02=+$O(^B PSC(BPIX,B PLDT02)) Q :BPLDT02=0 !(BPLDT02> BPENDDT1)   D
  950    . S BP02= 0 F  S BP0 2=$O(^BPSC (BPIX,BPLD T02,BP02))  Q:+BP02=0   D
  951    . . S BP5 9=+$O(^BPS T("AE",BP0 2,0))
  952    . . Q:BP5 9=0
  953    . . I $D( @BPGLTMP@( "FILE59",B P59)) Q
  954    . . S @BP GLTMP@("FI LE59",BP59 )=BPLDT02_ "^02"
  955    . . D PRO CESS(BP59)
  956    ;
  957    ;#9002313 .59 has on ly one ent ry per cla im with, w hich has a  date 
  958    ;  of the  latest up date for t he claim
  959    ;#9002313 .57 has mo re than on e entries  per claim  and keep a ll 
  960    ;  change s made the  claim
  961    ;so we ha ve to go t hru #90023 13.57 to f ind the ea rliest dat
  962    ;related  to the cla im to chec k it again st BPBEGDT
  963    S BPLDT57 =BPBEGDT-0 .00001
  964    F  S BPLD T57=+$O(^B PSTL("AH", BPLDT57))  Q:BPLDT57= 0!(BPLDT57 >BPENDDT)   D
  965    . S BP57= 0 F  S BP5 7=$O(^BPST L("AH",BPL DT57,BP57) ) Q:+BP57= 0  D
  966    . . S BP5 9=+$G(^BPS TL(BP57,0) )
  967    . . I $D( @BPGLTMP@( "FILE59",B P59)) Q
  968    . . S @BP GLTMP@("FI LE59",BP59 )=BPLDT57_ "^57"
  969    . . D PRO CESS(BP59)
  970    ;
  971    ;Remove P ortion of  Scratch Gl obal
  972   EXIT K @BP GLTMP@("FI LE59")
  973    Q OK
  974  
  975   Modified L ogic (Chan ges are hi ghlighted)
  976  
  977   COLLECT(BP GLTMP) N B P02,BP57,B P59,BPENDD T1,BPLDT02 ,BPLDT57,X ,Y,OK,BPIX
  978    ;
  979    ;Check Va riables
  980    S OK=1
  981    S:'$G(BPB EGDT) BPBE GDT=0
  982    S:'$G(BPE NDDT) BPEN DDT=999999 9
  983    S BPENDDT =BPENDDT+0 .9
  984    I $G(BPRT YPE)=""!($ G(BPGLTMP) ="")!($G(B PPHARM)="" )!($G(BPSU MDET)="")! ($G(BPINSI NF)="")!($ G(BPMWC)=" ")!($G(BPR TBCK)="")  S OK=-1 G  EXIT
  985    ;
  986    ; For the  Non-Billa ble Status  report, w e need to  loop throu gh the IB  NCPDP EVEN T LOG inst ead 
  987    ;   of BP S Claim/BP S Transact ion data
  988    I BPRTYPE =9 Q $$COL LECT^IBNCP EV3(BPBEGD T,BPENDDT, BPMWC,BPRL NRL,BPDRUG ,BPDRGCL,B PALRC,.BPP HARM,.BPIN SINF,.BPNB STS,.BPELI G1,BPGLTMP ,BPPAT,BPB ILL,$G(BPM IN),$G(BPM AX))
  989    ;
  990    ;Loop thr ough BPS C LAIMS
  991    ;
  992    ;First lo ok for fil l/refill c ross refer ence
  993    ;Loop thr ough Date  of Service  Index in  BPS CLAIMS  file and  find link  to 
  994    ;claim in  BPS TRANS ACTION.  P rocess ear liest Date  of Servic e entry fo und in
  995    ;BPS TRAN SACTION
  996    ;
  997    ;Choose I ndex to Lo op through  (differen t for Clos ed Claims)
  998    S BPIX="A F" S:BPRTY PE=7 BPIX= "AG"
  999    ;
  1000    S BPLDT02 =$S(BPIX=" AF":$$FM2Y MD(BPBEGDT -0.00001), 1:BPBEGDT)  S:BPLDT02 ="" BPLDT0 2=0
  1001    S BPENDDT 1=$S(BPIX= "AF":$$FM2 YMD(BPENDD T),1:BPEND DT_".99999 99999") S: BPENDDT1=" " BPENDDT1 =99999999
  1002    F  S BPLD T02=+$O(^B PSC(BPIX,B PLDT02)) Q :BPLDT02=0 !(BPLDT02> BPENDDT1)   D
  1003    . S BP02= 0 F  S BP0 2=$O(^BPSC (BPIX,BPLD T02,BP02))  Q:+BP02=0   D
  1004    . . S BP5 9=+$O(^BPS T("AE",BP0 2,0))
  1005    . . Q:BP5 9=0
  1006    . . I $D( @BPGLTMP@( "FILE59",B P59)) Q
  1007    . . S @BP GLTMP@("FI LE59",BP59 )=BPLDT02_ "^02"
  1008    . . D PRO CESS(BP59)
  1009    ;
  1010    ;#9002313 .59 has on ly one ent ry per cla im with, w hich has a  date 
  1011    ;  of the  latest up date for t he claim
  1012    ;#9002313 .57 has mo re than on e entries  per claim  and keep a ll 
  1013    ;  change s made the  claim
  1014    ;so we ha ve to go t hru #90023 13.57 to f ind the ea rliest dat
  1015    ;related  to the cla im to chec k it again st BPBEGDT
  1016    S BPLDT57 =BPBEGDT-0 .00001
  1017    F  S BPLD T57=+$O(^B PSTL("AH", BPLDT57))  Q:BPLDT57= 0!(BPLDT57 >BPENDDT)   D
  1018    . S BP57= 0 F  S BP5 7=$O(^BPST L("AH",BPL DT57,BP57) ) Q:+BP57= 0  D
  1019    . . S BP5 9=+$G(^BPS TL(BP57,0) )
  1020    . . I $D( @BPGLTMP@( "FILE59",B P59)) Q
  1021    . . S @BP GLTMP@("FI LE59",BP59 )=BPLDT57_ "^57"
  1022    . . D PRO CESS(BP59)
  1023    ;
  1024    ;Remove P ortion of  Scratch Gl obal
  1025   EXIT K @BP GLTMP@("FI LE59")
  1026    Q OK
  1027  
  1028  
  1029  
  1030  
  1031   Subroutine  Name
  1032   $$COLLECT^ IBNCPEV3
  1033   Enhancemen t Category
  1034    New
  1035    Modify
  1036    Delete
  1037    No Change
  1038   Current Lo gic
  1039  
  1040   IBNCPEV3 ; ALB/DMB -  ECME RXS W ITH NON-BI LLABLE STA TUS ;5/22/ 08
  1041    ;;2.0;INT EGRATED BI LLING;**53 4**;21-MAR -94;Build  18
  1042    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  1043    ;
  1044    ; ICR #61 31 documen ts the usa ge of this  entry poi nt by the  ECME appli cation
  1045    ;
  1046   COLLECT(BE GDT,ENDDT, MWC,RELNRL ,IBDRUG,DR UGCLS,ALLR CNT,IBPHAR M,IBINS,IB NBSTS,IBEL IG1,IBGLTM P) ;
  1047    ; Compile  the data  for the ne w Non-Bill able Statu s report
  1048    ; Input:
  1049    ;    BEGD T - Beginn ing Date
  1050    ;    ENDD T - Ending  Date
  1051    ;      MW C - A:All;  M:Mail; W :Window; C :CMOP Pres criptions
  1052    ;   RELNR L - 1:All;  2:Release d; 3:Not R eleased
  1053    ;   IBDRU G - 0:All;  DRUG to r eport on ( ptr to #50 )
  1054    ;  DRUGCL S - 0:All;  DRUG CLAS S to repor t on
  1055    ;  ALLRCN T - A:All;  R:Most re cent
  1056    ;  IBPHAR M/IBPHARM( ptr) - 0:A ll pharmac ies; 1:Arr ay of IENs  of pharma cies
  1057    ;  IBINS/ IBINS(ptr)  - 0:All i nsurances  or list of  file 36 I ENs
  1058    ;  IBNBST S/IBNBSTS( x) - 0:All ; 1:Array  of Non-Bil lable Stat us
  1059    ;  IBELIG 1/IBELIG1( x) - 0:All ; 1:Array  of multipl e eligibil ities
  1060    ;  IBGLTM P - Tempor ary Global  Storage ( returned w ith extrac ted data)
  1061    ; Output:
  1062    ;    1 -  Successful
  1063    ;   -1 -  Unsuccessf ul
  1064    ;     
  1065    ; Check P arameters
  1066    I $G(IBGL TMP)="" Q  -1
  1067    ;
  1068    N DATE,IE N,IEN1,X,X 0,X2,X7,DI V,INS,RX,F ILL,DRUG,R LDT,ELIG
  1069    N DFN,DRG COST,STATU S
  1070    K ^TMP($J )
  1071    ;
  1072    ; Loop th rough the  IB NCPDP E vent Log f or the dat a range
  1073    S DATE=BE GDT-.1 F   S DATE=$O( ^IBCNR(366 .14,"B",DA TE)) Q:'DA TE!(DATE>E NDDT)  D
  1074    . S IEN=" " F  S IEN =$O(^IBCNR (366.14,"B ",DATE,IEN )) Q:'IEN   D
  1075    .. S IEN1 =0 F  S IE N1=$O(^IBC NR(366.14, IEN,1,IEN1 )) Q:'IEN1   D
  1076    ... S X0= $G(^IBCNR( 366.14,IEN ,1,IEN1,0) )
  1077    ... ;
  1078    ... ; If  not a Bill able Statu s Check, q uit
  1079    ... I +X0 '=1 Q
  1080    ... ;
  1081    ... ; If  successful , quit
  1082    ... I $P( X0,"^",7)' =0 Q
  1083    ... ;
  1084    ... ; Che ck Non-Sta tus Reason  matches u ser input
  1085    ... I IBN BSTS=1,'$D (IBNBSTS(+ $P(X0,U,2) )) Q
  1086    ... ;
  1087    ... ; Che ck Divisio n matches  user input
  1088    ... S DIV =+$P(X0,U, 9)
  1089    ... I IBP HARM=1,'$D (IBPHARM(D IV)) Q
  1090    ... ;
  1091    ... ; Che ck Insuran ce matches  user inpu t
  1092    ... S INS =$$GETINS( IEN,IEN1)
  1093    ... I IBI NS'=0,'$$C HKINS(IBIN S,+INS) Q
  1094    ... S INS =$P(INS,"^ ",2)
  1095    ... ;
  1096    ... ; Get  Rx and Fi ll
  1097    ... S X2= $G(^IBCNR( 366.14,IEN ,1,IEN1,2) )
  1098    ... S RX= $P(X2,U,12 ),FILL=$P( X2,U,3)
  1099    ... I 'RX  S RX=$P(X 2,U,2)
  1100    ... I 'RX  Q
  1101    ... ;
  1102    ... ; Che ck Fill Ty pe matches  user inpu t
  1103    ... I MWC '="A",MWC' =$$MWC^PSO BPSU2(RX,F ILL) Q
  1104    ... ;
  1105    ... ; Che ck Drug ma tches user  input
  1106    ... S DRU G=$$FILE^I BRXUTL(RX, 6,"I")
  1107    ... I IBD RUG,IBDRUG '=DRUG Q
  1108    ... ;
  1109    ... ; Che ck Drug Cl ass matche s user inp ut
  1110    ... I DRU GCLS'=0,DR UGCLS'=$$C LSNAME($$D RUGDIE(DRU G,25,"I"))  Q
  1111    ... ;
  1112    ... ; Che ck Release d matches  user input
  1113    ... S RLD T=$P($$RXR LDT^PSOBPS UT(RX,FILL ),".")
  1114    ... I REL NRL'=1 Q:R ELNRL=2&'R LDT  Q:REL NRL=3&RLDT
  1115    ... ;
  1116    ... ; Che ck Eligibi lities mat ches user  input
  1117    ... S X7= $G(^IBCNR( 366.14,IEN ,1,IEN1,7) )
  1118    ... S ELI G=$P(X7,U, 5)
  1119    ... I IBE LIG1=1,'$D (IBELIG1(E LIG)) Q
  1120    ... ;
  1121    ... ; Get  Data
  1122    ... ;  Di vision, In surance, P atient Nam e, SSN, El igibility,  RX, Fill
  1123    ... ;  Da te, Drug C ost, Drug,  Released  On, Fill T ype,
  1124    ... ;  St atus (RX s tatus/Rele ased-Not r eleased)
  1125    ... S DFN =+$P(X0,U, 3)
  1126    ... S DRG COST=$$COS T(RX,FILL)
  1127    ... S STA TUS=$$RXAP I1^IBNCPUT 1(RX,100," I")
  1128    ... ; If  most recen t, tempora ry Sort by  RX and Fi ll
  1129    ... ; Els e store in  the globa l
  1130    ... I ALL RCNT="R" S  ^TMP($J," IBNCPEV3", +RX,+FILL, DATE)=DIV_ U_INS_U_DF N_U_ELIG_U _DRGCOST_U _0_U_DRUG_ U_RLDT_U_S TATUS_U_$P (X0,U,2)
  1131    ... E  S  @IBGLTMP@( DIV,INS,+D FN,DATE,+R X,+FILL)=E LIG_U_DRGC OST_U_0_U_ DRUG_U_RLD T_U_STATUS _U_$P(X0,U ,2)
  1132    ;
  1133    ; If most  recent, g et most re cent recor d for each  RX and fi ll and pop ulate the  array
  1134    I ALLRCNT ="R" D
  1135    . S RX=""  F  S RX=$ O(^TMP($J, "IBNCPEV3" ,RX)) Q:'R X  D
  1136    .. S FILL ="" F  S F ILL=$O(^TM P($J,"IBNC PEV3",RX,F ILL)) Q:FI LL=""  D
  1137    ... S DAT E=$O(^TMP( $J,"IBNCPE V3",RX,FIL L,""),-1)
  1138    ... S X=$ G(^TMP($J, "IBNCPEV3" ,RX,FILL,D ATE)),DIV= $P(X,U,1), INS=$P(X,U ,2),DFN=$P (X,U,3)
  1139    ... S @IB GLTMP@(DIV ,INS,+DFN, DATE,RX,FI LL)=$P(X,U ,4,10)
  1140    . ; Clean  up scratc h global
  1141    . K ^TMP( $J,"IBNCPE V3")
  1142    Q 1
  1143  
  1144   Modified L ogic (Chan ges are hi ghlighted)
  1145  
  1146   IBNCPEV3 ; ALB/DMB -  ECME RXS W ITH NON-BI LLABLE STA TUS ;5/22/ 08
  1147    ;;2.0;INT EGRATED BI LLING;**53 4,617**;21 -MAR-94;Bu ild 18
  1148    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  1149    ;
  1150    ; ICR #61 31 documen ts the usa ge of this  entry poi nt by the  ECME appli cation
  1151    ;
  1152   COLLECT(BE GDT,ENDDT, MWC,RELNRL ,IBDRUG,DR UGCLS,ALLR CNT,IBPHAR M,IBINS,IB NBSTS,IBEL IG1,IBGLTM P,IBPAT,IB BILL,IBMIN ,IBMAX) ;
  1153    ; Compile  the data  for the ne w Non-Bill able Statu s report
  1154    ; Input:
  1155    ;    BEGD T - Beginn ing Date
  1156    ;    ENDD T - Ending  Date
  1157    ;      MW C - A:All;  M:Mail; W :Window; C :CMOP Pres criptions,  if multip le entries  MWC="C,M"
  1158    ;   RELNR L - 1:All;  2:Release d; 3:Not R eleased
  1159    ;   IBDRU G - 0:All;  DRUG to r eport on ( ptr to #50 ), if mult iple entri es IBDRUG= ptr,ptr,.. .
  1160    ;  DRUGCL S - 0:All;  DRUG CLAS S to repor t on (ptr  to #50.5),  if multip le entries  DRUGCLS=p tr,ptr,...  
  1161    ;  ALLRCN T - A:All;  R:Most re cent
  1162    ;  IBPHAR M/IBPHARM( ptr) - 0:A ll pharmac ies; 1:Arr ay of IENs  of pharma cies
  1163    ;  IBINS/ IBINS(ptr)  - 0:All i nsurances  or list of  file 36 I ENs
  1164    ;  IBNBST S/IBNBSTS( x) - 0:All ; 1:Array  of Non-Bil lable Stat us
  1165    ;  IBELIG 1/IBELIG1( x) - 0:All ; 1:Array  of multipl e eligibil ities
  1166    ;  IBGLTM P - Tempor ary Global  Storage ( returned w ith extrac ted data)
  1167    ; IBPAT -  0:All; pt r to #2 PA TIENT, IBP AT=ptr,ptr ,... ; IBB ILL - 0:Al l; 1:Range  of Billed  Amount -  then check  IBMIN and  IBMAX ; I BMIN=minim um billed  amount ent ered, defa ult is 0 ;  IBMAX=max imum bille d amount e ntered, de fault is 9 99999 ;
  1168    ; Output:
  1169    ;    1 -  Successful
  1170    ;   -1 -  Unsuccessf ul
  1171    ;     
  1172    ; Check P arameters
  1173    I $G(IBGL TMP)="" Q  -1
  1174    ;
  1175    N DATE,IE N,IEN1,X,X 0,X2,X7,DI V,INS,RX,F ILL,DRUG,R LDT,ELIG
  1176    N DFN,DRG COST,I,IBD GLCS,IBSTO P,STATUS
  1177    K ^TMP($J )
  1178    ;
  1179    ; Loop th rough the  IB NCPDP E vent Log f or the dat a range
  1180    S DATE=BE GDT-.1 F   S DATE=$O( ^IBCNR(366 .14,"B",DA TE)) Q:'DA TE!(DATE>E NDDT)  D
  1181    . S IEN=" " F  S IEN =$O(^IBCNR (366.14,"B ",DATE,IEN )) Q:'IEN   D
  1182    .. S IEN1 =0 F  S IE N1=$O(^IBC NR(366.14, IEN,1,IEN1 )) Q:'IEN1   D
  1183    ... S X0= $G(^IBCNR( 366.14,IEN ,1,IEN1,0) )
  1184    ... ;
  1185    ... ; If  not a Bill able Statu s Check, q uit
  1186    ... I +X0 '=1 Q
  1187    ... ;
  1188    ... ; If  successful , quit
  1189    ... I $P( X0,"^",7)' =0 Q
  1190    ... ;
  1191    ... ; Che ck Non-Sta tus Reason  matches u ser input
  1192    ... I IBN BSTS=1,'$D (IBNBSTS(+ $P(X0,U,2) )) Q
  1193    ... ;
  1194    ... ; Che ck Divisio n matches  user input
  1195    ... S DIV =+$P(X0,U, 9)
  1196    ... I IBP HARM=1,'$D (IBPHARM(D IV)) Q
  1197    ... ;
  1198    ... ; Che ck Insuran ce matches  user inpu t
  1199    ... S INS =$$GETINS( IEN,IEN1)
  1200    ... I IBI NS'=0,'$$C HKINS(IBIN S,+INS) Q
  1201    ... S INS =$P(INS,"^ ",2)
  1202    ... ;
  1203    ... ; Get  Rx and Fi ll
  1204    ... S X2= $G(^IBCNR( 366.14,IEN ,1,IEN1,2) )
  1205    ... S RX= $P(X2,U,12 ),FILL=$P( X2,U,3)
  1206    ... I 'RX  S RX=$P(X 2,U,2)
  1207    ... I 'RX  Q
  1208    ... ;
  1209    ... ; Che ck Fill Ty pe matches  user inpu t
  1210    ... I MWC '="A",MWC' =$$MWC^PSO BPSU2(RX,F ILL) Q
  1211    ... ;
  1212    ... ; Che ck Drug ma tches user  input
  1213    ... S DRU G=$$FILE^I BRXUTL(RX, 6,"I")
  1214    ... I IBD RUG,IBDRUG '=DRUG Q
  1215    ... I IBD RUG D  I I BSTOP=0 Q  .... S IBS TOP=0 ....  F I=1:1:$ L(IBDRUG," ,") I DRUG =$P(IBDRUG ,",",I) S  IBSTOP=1 Q
  1216    ... ;
  1217    ... ; Che ck Drug Cl ass matche s user inp ut
  1218    ... I DRU GCLS'=0,DR UGCLS'=$$C LSNAME($$D RUGDIE(DRU G,25,"I"))  Q
  1219    ... S IBD GCLS=$$CLS NAME^IBNCP EV3($$GETD RGCL^IBNCP EV3(DRUG), 99) ... I  DRUGCLS'=0  D  I IBST OP=0 Q ... . S IBSTOP =0 .... F  I=1:1:$L(D RUGCLS,";" ) I IBDGCL S=$P(DRUGC LS,";",I)  S IBSTOP=1  Q
  1220    ... ;
  1221    ... ; Che ck Release d matches  user input
  1222    ... S RLD T=$P($$RXR LDT^PSOBPS UT(RX,FILL ),".")
  1223    ... I REL NRL'=1 Q:R ELNRL=2&'R LDT  Q:REL NRL=3&RLDT
  1224    ... ;
  1225    ... ; Che ck Eligibi lities mat ches user  input
  1226    ... S X7= $G(^IBCNR( 366.14,IEN ,1,IEN1,7) )
  1227    ... S ELI G=$P(X7,U, 5)
  1228    ... I IBE LIG1=1,'$D (IBELIG1(E LIG)) Q
  1229    ... ;
  1230    ... ; Che ck Patient (s) matche s user inp ut ... S D FN=+$P(X0, U,3) ... I  IBPAT'=0  D  I IBSTO P=0 Q ....  S IBSTOP= 0 .... F I =1:1:$L(IB PAT,",") I  $P(IBPAT, ",",I)=DFN  S IBSTOP= 1 Q ... ;  ... ; Chec k Drug Cos t matches  Bill Amoun t user inp ut ... S D RGCOST=$$C OST(RX,FIL L) ... I I BBILL'=0 I  (DRGCOST< $G(IBMIN)) !(DRGCOST> $G(IBMAX))  Q ... ;
  1231    ... ; Get  Data
  1232    ... ;  Di vision, In surance, P atient Nam e, SSN, El igibility,  RX, Fill
  1233    ... ;  Da te, Drug C ost, Drug,  Released  On, Fill T ype,
  1234    ... ;  St atus (RX s tatus/Rele ased-Not r eleased)
  1235    ... S DFN =+$P(X0,U, 3)
  1236    ... S DRG COST=$$COS T(RX,FILL)
  1237    ... S STA TUS=$$RXAP I1^IBNCPUT 1(RX,100," I")
  1238    ... ; If  most recen t, tempora ry Sort by  RX and Fi ll
  1239    ... ; Els e store in  the globa l
  1240    ... I ALL RCNT="R" S  ^TMP($J," IBNCPEV3", +RX,+FILL, DATE)=DIV_ U_INS_U_DF N_U_ELIG_U _DRGCOST_U _0_U_DRUG_ U_RLDT_U_S TATUS_U_$P (X0,U,2)
  1241    ... E  S  @IBGLTMP@( DIV,INS,+D FN,DATE,+R X,+FILL)=E LIG_U_DRGC OST_U_0_U_ DRUG_U_RLD T_U_STATUS _U_$P(X0,U ,2)
  1242    ;
  1243    ; If most  recent, g et most re cent recor d for each  RX and fi ll and pop ulate the  array
  1244    I ALLRCNT ="R" D
  1245    . S RX=""  F  S RX=$ O(^TMP($J, "IBNCPEV3" ,RX)) Q:'R X  D
  1246    .. S FILL ="" F  S F ILL=$O(^TM P($J,"IBNC PEV3",RX,F ILL)) Q:FI LL=""  D
  1247    ... S DAT E=$O(^TMP( $J,"IBNCPE V3",RX,FIL L,""),-1)
  1248    ... S X=$ G(^TMP($J, "IBNCPEV3" ,RX,FILL,D ATE)),DIV= $P(X,U,1), INS=$P(X,U ,2),DFN=$P (X,U,3)
  1249    ... S @IB GLTMP@(DIV ,INS,+DFN, DATE,RX,FI LL)=$P(X,U ,4,10)
  1250    . ; Clean  up scratc h global
  1251    . K ^TMP( $J,"IBNCPE V3")
  1252    Q 1
  1253  
  1254  
  1255  
  1256   Subroutine  Name
  1257   CLSNAME^IB NCPEV3
  1258   Enhancemen t Category
  1259    New
  1260    Modify
  1261    Delete
  1262    No Change
  1263   Current Lo gic
  1264  
  1265   CLSNAME(CL ASS) ; ; G et Drug Cl ass Name I  $G(CLASS) ="" Q "" K  ^TMP($J," IBPEV-CLAS S") N Y,IE N S Y="" D  C^PSN50P6 5(CLASS,"" ,"IBPEV-CL ASS") S IE N=$O(^TMP( $J,"IBPEV- CLASS",0))  I IEN]""  S Y=$G(^TM P($J,"IBPE V-CLASS",I EN,1)) K ^ TMP($J,"IB PEV-CLASS" ) Q Y
  1266  
  1267   Modified L ogic (Chan ges are hi ghlighted)
  1268  
  1269   CLSNAME(CL ASS,IBLEN)  ; ; Get D rug Class  Name I $G( CLASS)=""  Q "" K ^TM P($J,"IBPE V-CLASS")  N Y,IEN S  Y="" D C^P SN50P65(CL ASS,"","IB PEV-CLASS" ) S IEN=$O (^TMP($J," IBPEV-CLAS S",0)) I I EN]"" S Y= $E($G(^TMP ($J,"IBPEV -CLASS",IE N,1)),1,IB LEN) K ^TM P($J,"IBPE V-CLASS")  Q Y
  1270  
  1271  
  1272  
  1273  
  1274   A new subr outine was  added to  handle che cking the  Drug Class  criteria  for multip le selecti ons.  Thes e subrouti nes are mo deled afte r subrouti nes from B PSRPT6.
  1275  
  1276   Subroutine  Name
  1277   GETDRGCL^I BNCPEV3
  1278   Enhancemen t Category
  1279    New
  1280    Modify
  1281    Delete
  1282    No Change
  1283   Current Lo gic
  1284  
  1285   N/A - new  routine
  1286  
  1287   Modified L ogic (Chan ges are hi ghlighted)
  1288  
  1289    ;Get VA D RUG CLASS  pointer ;   ; Input V ariables:  BP50 - ptr  to DRUG ( #50) ; ; R eturn Valu e -> n = p tr to VA D RUG CLASS  (#50.605)  ; 0 = Unkn own ;GETDR GCL(BP50)  Q $$DRUGDI E(BP50,25)
  1290    ;
  1291  
  1292  
  1293  
  1294   The report  header wi ll need to  be modifi ed to disp lay the va lue of ALL  or SELECT ED for the  following  labels:   Insurance,  Drugs/Cla sses, Pati ent Name.   The label  Close Rea son will b e modified  for the C losed Clai ms Reports  to displa y the valu e of ALL o r SELECTED .
  1295  
  1296   Subroutine  Name
  1297   HDR^BPSRPT 7
  1298   Enhancemen t Category
  1299    New
  1300    Modify
  1301    Delete
  1302    No Change
  1303   Current Lo gic
  1304  
  1305   BPSRPT7 ;B HAM ISC/BE E - ECME R EPORTS ;14 -FEB-05 ;; 1.0;E CLAI MS MGMT EN GINE;**1,3 ,5,7,8,10, 11,19,20,2 3**;JUN 20 04;Build 2 7
  1306    
  1307   ...
  1308  
  1309    ;Print Re port Heade r
  1310    ; Input v ariables ( passed in)  – BPRTYPE  -> number  of report
  1311    ;                                - BPRPTNA M -> repor t name
  1312    ;                                - BPPAGE  -> report  page numbe r ; Input  variables  (defined i n BPSRPT0)  - BPPHARM ,BPSUMDET, BPNOW,BPMW C,BPRTBCK, BPINSINF ;                                             BPREJCD,BP CCRSN,BPAU TREV,BPACR EJ,BPQSTDR G
  1313    ;                                            BPDRUG,B PDRGCL,BPR ESC,BPOPCL ,BPRLNRL
  1314    ;                                            BPSORT,B PBEGDT,BPE NDDT ; Out put variab le - BPSDA TA -> Rese t to 0 to  show no ac tual data  has been p rinted ;                               on t he screen  ;                     BPPAGE ->  First set  in BPSRPT0 , report p age number  ;                     BPBLINE - > Controls  whether t o print a  blank line  ; HDR(BPR TYPE,BPRPT NAM,BPPAGE ) ; ;Displ ay Excel H eader I BP EXCEL D HD R^BPSRPT8( BPRTYPE) Q  ; ; Defin e BPPDATA  - Tells wh ether data  has been  displayed  for a scre en S BPSDA TA=0 S BPB LINE="" S  BPPAGE=$G( BPPAGE)+1  W @IOF W " ECME "_BPR PTNAM_" "_ $S(BPSUMDE T=1:"SUMMA RY",1:"DET AIL")_" RE PORT" I (" ,2,")'[BPR TYPE D . W  ?89,"Prin t Date: "_ $G(BPNOW)_ " Page:",$ J(BPPAGE,3 ) . W !,"D IVISION(S) : ",$$GETD IVS^BPSRPT 4(72,.BPPH ARM) . W ? 86,"Fill L ocations:  "_$S(BPMWC ="A":"C,M, W",1:BPMWC ) ; I (",2 ,")[BPRTYP E D . W ?8 7,"Print D ate: "_$G( BPNOW)_" P age:",$J(B PPAGE,3) .  W !,"DIVI SION(S): " ,$$GETDIVS ^BPSRPT4(7 2,.BPPHARM ) . W ?84, "Fill Loca tions: "_$ S(BPMWC="A ":"C,M,W", 1:BPMWC) .  W ?110,"F ill Type:  " . I BPRT BCK=1 W "R T,BB,P2,RS " Q . F I= 1:1:$L(BPR TBCK,",")  W:I'=1 ","  S RTBCKX= $P(BPRTBCK ,",",I) W  $S(RTBCKX= 2:"RT",RTB CKX=3:"BB" ,RTBCKX=4: "P2",RTBCK X=5:"RS",1 :"") ; I ( ",2,9,")'[ BPRTYPE W  ?110,"Fill  type: "_$ S(BPRTBCK= 2:"RT",BPR TBCK=3:"BB ",BPRTBCK= 4:"P2",BPR TBCK=5:"RS ",1:"RT,BB ,P2,RS") ;  I (",2,") [BPRTYPE W  !,"Insura nce: "_$S( BPINSINF=0 :"ALL",1:" SELECTED")  I (",2,") '[BPRTYPE  W !,"Insur ance: "_$S (BPINSINF= 0:"ALL",1: $$BPINS(BP INSINF)) ;  I (",7,") [BPRTYPE W  ?44,"Clos e Reason:  ",$E($$GET CLR^BPSRPT 6(BPCCRSN) ,1,26) I ( ",4,")[BPR TYPE W ?44 ,$J($S(BPA UTREV=0:"A LL",1:"AUT O"),4)," R eversals"  I (",4,")[ BPRTYPE W  ?60,$J($S( BPACREJ=1: "REJECTED" ,BPACREJ=2 :"ACCEPTED ",1:"ALL") ,8)," Retu rned Statu s" ; I (", 2,")'[BPRT YPE W ?87, "Drugs/Cla sses: "_$S (BPQSTDRG= 2:$$DRGNAM ^BPSRPT6(B PDRUG,30), BPQSTDRG=3 :$E(BPDRGC L,1,30),1: "ALL") I ( ",2,")[BPR TYPE D . W  ?85,"Drug s/Classes:  "_$S(BPQS TDRG'=1:"S ELECTED",1 :"ALL") .  W !,"Rejec t Code: ", $S(BPREJCD '=0:"SELEC TED",1:"AL L") . W ?8 7,"Eligibi lity: " D  . . I BPEL IG1=0 W "C VA,TRI,VET " Q . . S  (ABVELIG,L IST,N)=""  F  S N=$O( BPELIG1(N) ) Q:N=""   D . . . S  ABVELIG=$S (N="C":"CV A",N="T":" TRI",N="V" :"VET",1:" "),LIST=LI ST_$G(ABVE LIG)_"," .  . W $E(LI ST,1,$L(LI ST)-1) . W  ?113,"Ope n/Closed:  ",$S(BPOPC L=1:"CLOSE D",BPOPCL= 2:"OPEN",1 :"ALL") .  W !,"Presc riber: ",$ S(BPRESC'= 0:"SELECTE D",1:"ALL" ) . W ?91, "Patient:  ",$S(BPQST PAT'=0:"SE LECTED",1: "ALL") ; I  (",1,4,7, ")[BPRTYPE  W !,"Elig ibility: " ,$S(BPELIG ="V":"VET" ,BPELIG="T ":"TRI",BP ELIG="C":" CVA",1:"AL L") ; I (" ,9,")[BPRT YPE D . W  !,"Eligibi lities: ", $S(BPELIG1 =0:"ALL",1 :$$ELIG(.B PELIG1)) .  W !,"NON- BILLABLE S TATUS: "_$ S(BPNBSTS= 0:"ALL",1: $$NBSTS(.B PNBSTS)) ;  W !,$S(BP RTYPE=5:"P RESCRIPTIO NS",BPRLNR L=2:"RELEA SED PRESCR IPTIONS",B PRLNRL=3:" PRESCRIPTI ONS (NOT R ELEASED)", 1:"ALL PRE SCRIPTIONS ") W " BY  "_$S(BPRTY PE=7:"CLOS E",1:"TRAN SACTION")_ " DATE: "  W "From "_ $$DATTIM^B PSRPT1(BPB EGDT)_" th rough "_$$ DATTIM^BPS RPT1($P(BP ENDDT,".") ) ; D ULIN E^BPSRPT5( "=") Q:$G( BPQ) D HEA DLN1^BPSRP T4(BPRTYPE ) D HEADLN 2^BPSRPT4( BPRTYPE) D  HEADLN3^B PSRPT4(BPR TYPE) D UL INE^BPSRPT 5("=") ; ; Print Divi sion I $G( BPDIV)]""  D .W !,"DI VISION: ", $S(BPDIV=0 :"BLANK",B PDIV="ALL  DIVISIONS" :"ALL DIVI SIONS",$$D IVNAME^BPS SCRDS(BPDI V)]"":$$DI VNAME^BPSS CRDS(BPDIV ),1:BPDIV)  .I BPRTYP E=5!(BPRTY PE=6)!(BPS UMDET=1)!( BPGRPLAN=" ") D ULINE ^BPSRPT5(" -") ; ;Pri nt Insuran ce If Defi ned I BPSU MDET=0,$G( BPGRPLAN)] "",$G(BPGR PLAN)'=0,$ G(BPGRPLAN )'="~" D W RPLAN^BPSR PT5(BPGRPL AN) Q
  1315  
  1316   Modified L ogic (Chan ges are hi ghlighted)
  1317  
  1318   BPSRPT7 ;B HAM ISC/BE E - ECME R EPORTS ;14 -FEB-05 ;; 1.0;E CLAI MS MGMT EN GINE;**1,3 ,5,7,8,10, 11,19,20,2 3,24**;JUN  2004;Buil d 27
  1319    
  1320   ...
  1321  
  1322    ;Print Re port Heade r
  1323    ; Input v ariables ( passed in)  – BPRTYPE  -> number  of report
  1324    ;                                - BPRPTNA M -> repor t name
  1325    ;                                - BPPAGE  -> report  page numbe r ; Input  variables  (defined i n BPSRPT0)  - BPPHARM ,BPSUMDET, BPNOW,BPMW C,BPRTBCK, BPINSINF ;                                             BPREJCD,BP CCRSN,BPAU TREV,BPACR EJ,BPQSTDR G
  1326    ;                                            BPDRUG,B PDRGCL,BPR ESC,BPOPCL ,BPRLNRL
  1327    ;                                            BPSORT,B PBEGDT,BPE NDDT ; Out put variab le - BPSDA TA -> Rese t to 0 to  show no ac tual data  has been p rinted ;                               on t he screen  ;                     BPPAGE ->  First set  in BPSRPT0 , report p age number  ;                     BPBLINE - > Controls  whether t o print a  blank line  ; HDR(BPR TYPE,BPRPT NAM,BPPAGE ) ; ;Displ ay Excel H eader I BP EXCEL D HD R^BPSRPT8( BPRTYPE) Q  ; ; Defin e BPPDATA  - Tells wh ether data  has been  displayed  for a scre en S BPSDA TA=0 S BPB LINE="" S  BPPAGE=$G( BPPAGE)+1  W @IOF W " ECME "_BPR PTNAM_" "_ $S(BPSUMDE T=1:"SUMMA RY",1:"DET AIL")_" RE PORT" W ?8 9,"Print D ate: "_$G( BPNOW)_" P age:",$J(B PPAGE,3) W  !,"DIVISI ON(S): ",$ $GETDIVS^B PSRPT4(72, .BPPHARM)
  1328    W ?86,"Fi ll Locatio ns: "_$S(B PMWC="A":" C,M,W",1:B PMWC)
  1329    ; I (",2, ")[BPRTYPE  D . W ?87 ,"Print Da te: "_$G(B PNOW)_" Pa ge:",$J(BP PAGE,3) .  W !,"DIVIS ION(S): ", $$GETDIVS^ BPSRPT4(72 ,.BPPHARM)  . W ?84," Fill Locat ions: "_$S (BPMWC="A" :"C,M,W",1 :BPMWC) .  W ?110,"Fi ll Type: "  . I BPRTB CK=1 W "RT ,BB,P2,RS"  Q . F I=1 :1:$L(BPRT BCK,",") W :I'=1 ","  S RTBCKX=$ P(BPRTBCK, ",",I) W $ S(RTBCKX=2 :"RT",RTBC KX=3:"BB", RTBCKX=4:" P2",RTBCKX =5:"RS",1: "") ; I (" ,2,9,")'[B PRTYPE W ? 110,"Fill  type: "_$S (BPRTBCK=2 :"RT",BPRT BCK=3:"BB" ,BPRTBCK=4 :"P2",BPRT BCK=5:"RS" ,1:"RT,BB, P2,RS") ;  I (",2,")[ BPRTYPE W  !,"Insuran ce: "_$S(B PINSINF=0: "ALL",1:"S ELECTED")  I (",2,")' [BPRTYPE W  !,"Insura nce: "_$S( BPINSINF=0 :"ALL",1:$ $BPINS(BPI NSINF))
  1330    ; I (",1, 2,3,4,7,") [BPRTYPE D  . W ?110, "Fill Type : " . I BP RTBCK=1 W  "RT,BB,P2, RS" Q . F  I=1:1:$L(B PRTBCK,"," ) W:I'=1 " ," S RTBCK X=$P(BPRTB CK,",",I)  W $S(RTBCK X=2:"RT",R TBCKX=3:"B B",RTBCKX= 4:"P2",RTB CKX=5:"RS" ,1:"") ;
  1331    I (",1,2, 3,4,7,9,") [BPRTYPE W  !,"Insura nce: "_$S( BPINSINF=0 :"ALL",1:" SELECTED")  ; I (",5, 6,8,")[BPR TYPE D . W  ?110,"Fil l type: "_ $S(BPRTBCK =2:"RT",BP RTBCK=3:"B B",BPRTBCK =4:"P2",BP RTBCK=5:"R S",1:"RT,B B,P2,RS")  . W !,"Ins urance: "_ $S(BPINSIN F=0:"ALL", 1:$$BPINS( BPINSINF))  ;
  1332    I (",7,") [BPRTYPE W  ?44,"Clos e Reason:  ",$S(BPCCR SN’=0:"SEL ECTED",1:" ALL") I (" ,4,")[BPRT YPE D 
  1333    . W ?44,$ J($S(BPAUT REV=0:"ALL ",1:"AUTO" ),4)," Rev ersals" I  (",4,")[BP RTYPE . W  ?60,$J($S( BPACREJ=1: "REJECTED" ,BPACREJ=2 :"ACCEPTED ",1:"ALL") ,8)," Retu rned Statu s"
  1334    ; I (",2, 5,6,8,")’[ BPRTYPE W  ?87,"Drugs /Classes:  "_$S(BPQST DRG=1:"ALL ",BPQSTDRG =2:$$DRGNA M^BPSRPT6( BPDRUG,30) ,BPQSTDRG= 3:$E(BPDRG CL,1,30),1 :"ALL")
  1335    I (",1,2, 3,4,7,9,") [BPRTYPE D  .W ?85,"D rugs/Class es: "_$S(B PQSTDRG’=1 :"SELECTED ",1:"ALL")
  1336    I (",2,") [BPRTYPE D
  1337    . W !,"Re ject Code:  ",$S(BPRE JCD’=0:"SE LECTED",1: "ALL")
  1338    . W ?87," Eligibilit y: " D . .  I BPELIG1 =0 W "ALL"  Q . . S ( ABVELIG,LI ST,N)="" F   S N=$O(B PELIG1(N))  Q:N=""  D  . . . S A BVELIG=$S( N="C":"CVA ",N="T":"T RI",N="V": "VET",1:"A LL"),LIST= LIST_$G(AB VELIG)_","  . . W $E( LIST,1,$L( LIST)-1)
  1339    . W ?113, "Open/Clos ed: ",$S(B POPCL=1:"C LOSED",BPO PCL=2:"OPE N",1:"ALL" )
  1340    . W !,"Pr escriber:  ",$S(BPRES C’=1:"SELE CTED",1:"A LL")
  1341    . W ?91," Patient: " ,$S(BPQSTP AT'=0:"SEL ECTED",1:" ALL")
  1342    ;
  1343    I (",1,3, 4,7,9,")[B PRTYPE D
  1344    . W "Elig ibility: "  D . . I B PELIG1=0 W  "CVA,TRI, VET" Q  ;  ALL was se lected . .  S (ABVELI G,LIST,N)= "" F  S N= $O(BPELIG1 (N)) Q:N=" "  D . . .  S ABVELIG =$S(N="C": "CVA",N="T ":"TRI",N= "V":"VET", 1:""),LIST =LIST_$G(A BVELIG)_", " . . W $E (LIST,1,$L (LIST)-1)
  1345    . W ?91," Patient: " ,$S(BPQSTP AT'=0:"SEL ECTED",1:" ALL")
  1346    ;
  1347    I (",1,4, 7,")[BPRTY PE W !,"El igibility:  ",$S(BPEL IG="V":"VE T",BPELIG= "T":"TRI", BPELIG="C" :"CVA",1:" ALL") I (" ,9,")[BPRT YPE D . W  !,"Eligibi lities: ", $S(BPELIG1 =0:"ALL",1 :$$ELIG(.B PELIG1)) .  W !,"NON- BILLABLE S TATUS: "_$ S(BPNBSTS= 0:"ALL",1: $$NBSTS(.B PNBSTS))
  1348    ; W !,$S( BPRTYPE=5: "PRESCRIPT IONS",BPRL NRL=2:"REL EASED PRES CRIPTIONS" ,BPRLNRL=3 :"PRESCRIP TIONS (NOT  RELEASED) ",1:"ALL P RESCRIPTIO NS") W " B Y "_$S(BPR TYPE=7:"CL OSE",1:"TR ANSACTION" )_" DATE:  " W "From  "_$$DATTIM ^BPSRPT1(B PBEGDT)_"  through "_ $$DATTIM^B PSRPT1($P( BPENDDT,". ")) ; D UL INE^BPSRPT 5("=") Q:$ G(BPQ) D H EADLN1^BPS RPT4(BPRTY PE) D HEAD LN2^BPSRPT 4(BPRTYPE)  D HEADLN3 ^BPSRPT4(B PRTYPE) D  ULINE^BPSR PT5("=") ;  ;Print Di vision I $ G(BPDIV)]" " D .W !," DIVISION:  ",$S(BPDIV =0:"BLANK" ,BPDIV="AL L DIVISION S":"ALL DI VISIONS",$ $DIVNAME^B PSSCRDS(BP DIV)]"":$$ DIVNAME^BP SSCRDS(BPD IV),1:BPDI V) .I BPRT YPE=5!(BPR TYPE=6)!(B PSUMDET=1) !(BPGRPLAN ="") D ULI NE^BPSRPT5 ("-") ; ;P rint Insur ance If De fined I BP SUMDET=0,$ G(BPGRPLAN )]"",$G(BP GRPLAN)'=0 ,$G(BPGRPL AN)'="~" D  WRPLAN^BP SRPT5(BPGR PLAN) Q 
  1349  
  1350  
  1351   Add eligib ility to t he column  heading af ter COB an d the data  for the C laims Subm itted, Not  Yet Relea sed Report .  
  1352  
  1353   Subroutine  Name
  1354   HEADLN2^BP SRPT4
  1355   Enhancemen t Category
  1356    New
  1357    Modify
  1358    Delete
  1359    No Change
  1360   Current Lo gic
  1361  
  1362    ;Print He ader 2 Lin e 2 ; ; In put variab le: BPRTYP E -> Repor t Type (1- 9) ; HEADL N2(BPRTYPE ) ; I (BPR TYPE=1)!(B PRTYPE=4)  D  Q . W ! ,?4,"DRUG"  . W ?36," NDC" . I B PRTYPE=1 W  ?47,"RELE ASED ON" .  W ?68,"RX  INFO" . I  BPRTYPE=4  W ?92,"CO B" . I BPR TYPE=1 W ? 120,"BILL# ",?129,"CO B" ; I BPR TYPE=2 D   Q . W !,?3 ,"CARDHOLD .ID" . W ? 26,"GROUP  ID" . W ?4 1,$J("$BIL LED",10) .  W ?54,"QT Y" . W ?61 ,"NDC#" .  W ?82,"PRE SCRIBER ID " . W ?98, "NAME" ; I  BPRTYPE=3  D  Q . W  !,?4,"DRUG " . W ?43, "NDC" . W  ?68,"RX IN FO" . W ?8 8,"COB" ;  I BPRTYPE= 5 D  Q . W  !,?4,"DRU G" . W ?32 ,"NDC" . W  ?47,"RX I NFO" . W ? 69,"INSURA NCE" . W ? 112,"ELAP  TIME IN SE CONDS" ; I  BPRTYPE=6  D  Q .W ! ,?1,"DATE"  .W ?15,$J ("#CLAIMS" ,17) .W ?3 3,$J("SUBM ITTED",17)  .W ?51,$J ("REJECTED ",17) .W ? 69,$J("PAY ABLE",17)  .W ?87,$J( "TO RECEIV E",17) .W  ?115,$J("D IFFERENCE" ,17) ; I B PRTYPE=7 D   Q . W !, ?3,"CARDHO LD.ID" . W  ?27,"GROU P ID" . W  ?46,"CLOSE  DATE/TIME " . W ?65, "CLOSED BY " . W ?93, "CLOSE REA SON" . W ? 126,"COB"  ; I BPRTYP E=8 D  Q .  W !,?2,"D RUG" . W ? 38,"RX INF O" . W ?54 ,"INS GROU P#" . W ?7 2,"INS GRO UP NAME" .  W ?125,"B ILL#" ; I  BPRTYPE=9  D  Q . W ! ,?4,"DRUG"  . W ?36," NDC" . W ? 47,"RELEAS ED ON" . W  ?62,"RX I NFO" . W ? 75,"NON-BI LLABLE STA TUS" Q 
  1363  
  1364   Modified L ogic (Chan ges are hi ghlighted)
  1365    
  1366    ;Print He ader 2 Lin e 2 ; ; In put variab le: BPRTYP E -> Repor t Type (1- 9) ; HEADL N2(BPRTYPE ) ; I (BPR TYPE=1)!(B PRTYPE=4)  D  Q . W ! ,?4,"DRUG"  . W ?36," NDC" . I B PRTYPE=1 W  ?47,"RELE ASED ON" .  W ?68,"RX  INFO" . I  BPRTYPE=4  W ?92,"CO B" . I BPR TYPE=1 W ? 120,"BILL# ",?129,"CO B" ; I BPR TYPE=2 D   Q . W !,?3 ,"CARDHOLD .ID" . W ? 26,"GROUP  ID" . W ?4 1,$J("$BIL LED",10) .  W ?54,"QT Y" . W ?61 ,"NDC#" .  W ?82,"PRE SCRIBER ID " . W ?98, "NAME" ; I  BPRTYPE=3  D  Q . W  !,?4,"DRUG " . W ?43, "NDC" . W  ?68,"RX IN FO" . W ?8 8,"COB"
  1367    . W ?96," ELIG" ; I  BPRTYPE=5  D  Q . W ! ,?4,"DRUG"  . W ?32," NDC" . W ? 47,"RX INF O" . W ?69 ,"INSURANC E" . W ?11 2,"ELAP TI ME IN SECO NDS" ; I B PRTYPE=6 D   Q . W !, ?1,"DATE"  . W ?15,$J ("#CLAIMS" ,17) . W ? 33,$J("SUB MITTED",17 ) . W ?51, $J("REJECT ED",17) .  W ?69,$J(" PAYABLE",1 7) . W ?87 ,$J("TO RE CEIVE",17)  . W ?115, $J("DIFFER ENCE",17)  ; I BPRTYP E=7 D  Q .  W !,?3,"C ARDHOLD.ID " . W ?27, "GROUP ID"  . W ?46," CLOSE DATE /TIME" . W  ?65,"CLOS ED BY" . W  ?93,"CLOS E REASON"  . W ?126," COB" ; I B PRTYPE=8 D   Q . W !, ?2,"DRUG"  . W ?38,"R X INFO" .  W ?54,"INS  GROUP#" .  W ?72,"IN S GROUP NA ME" . W ?1 25,"BILL#"  ; I BPRTY PE=9 D  Q  . W !,?4," DRUG" . W  ?36,"NDC"  . W ?47,"R ELEASED ON " . W ?62, "RX INFO"  . W ?75,"N ON-BILLABL E STATUS" 
  1368  
  1369  
  1370   Subroutine  Name
  1371   WRLINE2^BP SRPT5
  1372   Enhancemen t Category
  1373    New
  1374    Modify
  1375    Delete
  1376    No Change
  1377   Current Lo gic
  1378  
  1379    ;Print Re port Line  2WRLINE2(B PRTYPE,BPR EC,BPX,BPR X,BPREF,BP BIL,BPGRPL AN,BPEXCEL ,BPICNT,BP PSEQ) ; ;E xcel Outpu t N BPSX I  $G(BPEXCE L) D WRLIN E2^BPSRPT8 (BPRTYPE,. BPREC,BPX, BPRX,BPREF ,BPBIL,BPG RPLAN,BPPS EQ) Q ;Rep ort Output  I (BPRTYP E=1)!(BPRT YPE=4) D   Q . W !,?4 ,$$DRGNAM^ BPSRPT6($P (BPX,U,14) ,27),?32,$ $GETNDC^BP SRPT6(BPRX ,BPREF) .  I BPRTYPE= 1 W ?47,$$ DATTIM^BPS RPT1(+BPX)  . W ?68,$ $MWC^BPSRP T6(BPRX,BP REF) . W ? 71,$$RTBCK NAM^BPSRPT 1($$RTBCK^ BPSRPT1($P (BPX,U,3)) ) . W ?75, $$RXSTATUS ^BPSRPT6($ P(BPX,U,3) ) . W ?77, $S($P(BPX, U):"/R",1: "/N") . W  ?82,$S($P( BPX,U,13): "REJ",1:"" ) . I BPRT YPE=4 W ?9 2,$$RXCOB^ BPSRPT8(BP PSEQ) . I  BPRTYPE=1  W ?115,$$B ILLCOB(BPR X,BPREF,BP PSEQ) I BP RTYPE=2 D   Q . W !,? 3,$E($$CRD HLDID^BPSR PT2(+$P(BP X,U,3)),3, 23) . W ?2 6,$E($$GRP ID^BPSRPT2 (+$P(BPX,U ,3)),3,17)  . W ?41,$ J(BPBIL,10 ,2) . W ?5 4,$$QTY^BP SRPT6($P(B PX,U,3)) .  W ?61,$$G ETNDC^BPSR PT6(BPRX,B PREF) . S  BPSX=$$PRE SCIN^BPSRP T6($P(BPX, U,3)) . W  ?82,$P(BPS X,U),?98,$ P(BPSX,U,2 ) I BPRTYP E=3 D  Q .  W !,?4,$$ DRGNAM^BPS RPT6($P(BP X,U,14),32 ) . W ?41, $$GETNDC^B PSRPT6(BPR X,BPREF) .  W ?68,$$M WC^BPSRPT6 (BPRX,BPRE F) . W ?71 ,$$RTBCKNA M^BPSRPT1( $$RTBCK^BP SRPT1($P(B PX,U,3)))  . W ?74,$$ RXSTATUS^B PSRPT6($P( BPX,U,3))  . W ?76,$S ($P(BPX,U) :"/R",1:"/ N") . W ?8 1,$S($P(BP X,U,13):"R EJ",1:"")  . W ?88,$$ RXCOB^BPSR PT8(BPPSEQ ) I BPRTYP E=5 D  Q .  W !,?4,$$ DRGNAM^BPS RPT6($P(BP X,U,14),23 ) . W ?28, $$GETNDC^B PSRPT6(BPR X,BPREF) .  W ?47,$$M WC^BPSRPT6 (BPRX,BPRE F) . W ?50 ,$$RTBCKNA M^BPSRPT1( $$RTBCK^BP SRPT1($P(B PX,U,3)))  . W ?53,$$ RXSTATUS^B PSRPT6($P( BPX,U,3))  . W ?55,$S ($P(BPX,U) :"/R",1:"/ N") . W ?6 0,$S($P(BP X,U,13):"R EJ",1:"")  . I $P(BPG RPLAN,U,2) ]"" W ?69, $E($P(BPGR PLAN,U,2), 1,30) . W  ?122,$J($$ ELAPSE^BPS RPT6($P(BP X,U,3)),10 ) I BPRTYP E=7 D  Q .  W !,?3,$E ($$CRDHLDI D^BPSRPT2( +$P(BPX,U, 3)),3,23)  . W ?28,$E ($$GRPID^B PSRPT2(+$P (BPX,U,3)) ,3,17) . W  ?46,$$DAT TIM^BPSRPT 1(+$$CLOSE DT^BPSRPT2 (+$P(BPX,U ,3))) . N  BPCLBY S B PCLBY=$E($ $CLSBY^BPS RPT6(+$P(B PX,U,3)),1 ,25) S:BPC LBY="" BPC LBY="BLANK " . W ?65, BPCLBY S B PCNT(BPCLB Y)=$G(BPCN T(BPCLBY)) +1,BPGCNT( BPCLBY)=$G (BPGCNT(BP CLBY))+1,B PICNT(BPCL BY)=$G(BPI CNT(BPCLBY ))+1 . W ? 93,$E($P($ $CLRSN^BPS RPT7(+$P(B PX,U,3)),U ,2),1,30)  . W ?128,$ $RXCOB^BPS RPT8(BPPSE Q) I BPRTY PE=8 D  Q  . W !,?2,$ $DRGNAM^BP SRPT6($P(B PX,U,14),3 4) . W ?38 ,$$MWC^BPS RPT6(BPRX, BPREF) . W  ?42,$$RTB CKNAM^BPSR PT1($$RTBC K^BPSRPT1( $P(BPX,U,3 ))) . W ?4 6,$$RXSTAT US^BPSRPT6 ($P(BPX,U, 3)) . W ?4 8,$S($P(BP X,U):"/R", 1:"/N") .  W ?54,$E($ $GRPID^BPS RPT2(+$P(B PX,U,3)),3 ,10) . W ? 72,$E(BPGR PLAN,1,50)  . W ?125, $$BILL^BPS RPT6(BPRX, BPREF,BPPS EQ) I BPRT YPE=9 D  Q  . W !,?4, $$DRGNAM^B PSRPT6($P( BPX,U,4),2 7) ;Drug .  W ?32,$$G ETNDC^BPSR PT6(BPRX,B PREF) ;NDC  . W ?47,$ $DATTIM^BP SRPT1($P(B PX,U,5)) ; Release Da te . W ?62 ,$$MWC^BPS RPT6(BPRX, BPREF) ;Fi ll Locatio n . W ?65, $$RXSTANAM ^BPSSCRU2( $P(BPX,U,6 )) ;Status  . W ?67,$ S($P(BPX,U ,5):"/R",1 :"/N") ;Re leased . W  ?75,$E($$ GET1^DIQ(3 66.17,$P(B PX,U,7),.0 1,"E"),1,5 7) ;Non-Bi llalble Re ason - ICR  6136 Q
  1380  
  1381   Modified L ogic (Chan ges are hi ghlighted)
  1382    
  1383    ;Print Re port Line  2WRLINE2(B PRTYPE,BPR EC,BPX,BPR X,BPREF,BP BIL,BPGRPL AN,BPEXCEL ,BPICNT,BP PSEQ) ; ;E xcel Outpu t N BPSX I  $G(BPEXCE L) D WRLIN E2^BPSRPT8 (BPRTYPE,. BPREC,BPX, BPRX,BPREF ,BPBIL,BPG RPLAN,BPPS EQ) Q ;Rep ort Output  I (BPRTYP E=1)!(BPRT YPE=4) D   Q . W !,?4 ,$$DRGNAM^ BPSRPT6($P (BPX,U,14) ,27),?32,$ $GETNDC^BP SRPT6(BPRX ,BPREF) .  I BPRTYPE= 1 W ?47,$$ DATTIM^BPS RPT1(+BPX)  . W ?68,$ $MWC^BPSRP T6(BPRX,BP REF) . W ? 71,$$RTBCK NAM^BPSRPT 1($$RTBCK^ BPSRPT1($P (BPX,U,3)) ) . W ?75, $$RXSTATUS ^BPSRPT6($ P(BPX,U,3) ) . W ?77, $S($P(BPX, U):"/R",1: "/N") . W  ?82,$S($P( BPX,U,13): "REJ",1:"" ) . I BPRT YPE=4 W ?9 2,$$RXCOB^ BPSRPT8(BP PSEQ) . I  BPRTYPE=1  W ?115,$$B ILLCOB(BPR X,BPREF,BP PSEQ) I BP RTYPE=2 D   Q . W !,? 3,$E($$CRD HLDID^BPSR PT2(+$P(BP X,U,3)),3, 23) . W ?2 6,$E($$GRP ID^BPSRPT2 (+$P(BPX,U ,3)),3,17)  . W ?41,$ J(BPBIL,10 ,2) . W ?5 4,$$QTY^BP SRPT6($P(B PX,U,3)) .  W ?61,$$G ETNDC^BPSR PT6(BPRX,B PREF) . S  BPSX=$$PRE SCIN^BPSRP T6($P(BPX, U,3)) . W  ?82,$P(BPS X,U),?98,$ P(BPSX,U,2 ) I BPRTYP E=3 D  Q .  W !,?4,$$ DRGNAM^BPS RPT6($P(BP X,U,14),32 ) . W ?41, $$GETNDC^B PSRPT6(BPR X,BPREF) .  W ?68,$$M WC^BPSRPT6 (BPRX,BPRE F) . W ?71 ,$$RTBCKNA M^BPSRPT1( $$RTBCK^BP SRPT1($P(B PX,U,3)))  . W ?74,$$ RXSTATUS^B PSRPT6($P( BPX,U,3))  . W ?76,$S ($P(BPX,U) :"/R",1:"/ N") . W ?8 1,$S($P(BP X,U,13):"R EJ",1:"")  . W ?88,$$ RXCOB^BPSR PT8(BPPSEQ )
  1384    . N ELGCD  S ELGCD=$ $ELIGCODE^ BPSSCR05($ P(BPX,U,3) ) . W ?96, $S(ELGCD=" V":"VET",E LGCD="T":" TRI",ELGCD ="C":"CVA" ,1:"UNK")  I BPRTYPE= 5 D  Q . W  !,?4,$$DR GNAM^BPSRP T6($P(BPX, U,14),23)  . W ?28,$$ GETNDC^BPS RPT6(BPRX, BPREF) . W  ?47,$$MWC ^BPSRPT6(B PRX,BPREF)  . W ?50,$ $RTBCKNAM^ BPSRPT1($$ RTBCK^BPSR PT1($P(BPX ,U,3))) .  W ?53,$$RX STATUS^BPS RPT6($P(BP X,U,3)) .  W ?55,$S($ P(BPX,U):" /R",1:"/N" ) . W ?60, $S($P(BPX, U,13):"REJ ",1:"") .  I $P(BPGRP LAN,U,2)]" " W ?69,$E ($P(BPGRPL AN,U,2),1, 30) . W ?1 22,$J($$EL APSE^BPSRP T6($P(BPX, U,3)),10)  I BPRTYPE= 7 D  Q . W  !,?3,$E($ $CRDHLDID^ BPSRPT2(+$ P(BPX,U,3) ),3,23) .  W ?28,$E($ $GRPID^BPS RPT2(+$P(B PX,U,3)),3 ,17) . W ? 46,$$DATTI M^BPSRPT1( +$$CLOSEDT ^BPSRPT2(+ $P(BPX,U,3 ))) . N BP CLBY S BPC LBY=$E($$C LSBY^BPSRP T6(+$P(BPX ,U,3)),1,2 5) S:BPCLB Y="" BPCLB Y="BLANK"  . W ?65,BP CLBY S BPC NT(BPCLBY) =$G(BPCNT( BPCLBY))+1 ,BPGCNT(BP CLBY)=$G(B PGCNT(BPCL BY))+1,BPI CNT(BPCLBY )=$G(BPICN T(BPCLBY)) +1 . W ?93 ,$E($P($$C LRSN^BPSRP T7(+$P(BPX ,U,3)),U,2 ),1,30) .  W ?128,$$R XCOB^BPSRP T8(BPPSEQ)  I BPRTYPE =8 D  Q .  W !,?2,$$D RGNAM^BPSR PT6($P(BPX ,U,14),34)  . W ?38,$ $MWC^BPSRP T6(BPRX,BP REF) . W ? 42,$$RTBCK NAM^BPSRPT 1($$RTBCK^ BPSRPT1($P (BPX,U,3)) ) . W ?46, $$RXSTATUS ^BPSRPT6($ P(BPX,U,3) ) . W ?48, $S($P(BPX, U):"/R",1: "/N") . W  ?54,$E($$G RPID^BPSRP T2(+$P(BPX ,U,3)),3,1 0) . W ?72 ,$E(BPGRPL AN,1,50) .  W ?125,$$ BILL^BPSRP T6(BPRX,BP REF,BPPSEQ ) I BPRTYP E=9 D  Q .  W !,?4,$$ DRGNAM^BPS RPT6($P(BP X,U,4),27)  ;Drug . W  ?32,$$GET NDC^BPSRPT 6(BPRX,BPR EF) ;NDC .  W ?47,$$D ATTIM^BPSR PT1($P(BPX ,U,5)) ;Re lease Date  . W ?62,$ $MWC^BPSRP T6(BPRX,BP REF) ;Fill  Location  . W ?65,$$ RXSTANAM^B PSSCRU2($P (BPX,U,6))  ;Status .  W ?67,$S( $P(BPX,U,5 ):"/R",1:" /N") ;Rele ased . W ? 75,$E($$GE T1^DIQ(366 .17,$P(BPX ,U,7),.01, "E"),1,57)  ;Non-Bill alble Reas on - ICR 6 136 Q
  1385  
  1386  
  1387   For the Cl osed Claim  Report, a dd informa tion about  instructi ons about  fields tha t will be  included i n the Exce l document  but not d isplayed o n the repo rt.  This  informatio n will be  added prio r to the   ‘Do you wa nt to capt ure report  data for  an Excel d ocument?’  prompt.
  1388  
  1389   Subroutine  Name
  1390   SELEXCEL^B PSRPT4
  1391   Enhancemen t Category
  1392    New
  1393    Modify
  1394    Delete
  1395    No Change
  1396   Current Lo gic
  1397  
  1398   SELEXCEL()  ; - Retur ns whether  to captur e data for  Excel rep ort.
  1399    ; Output:  EXCEL = 1  - YES (ca pture data ) / 0 - NO  (DO NOT c apture dat a)
  1400    ;
  1401    N EXCEL,D IR,DIRUT,D TOUT,DUOUT ,DIROUT
  1402    I ",1,2,3 ,4,"[(","_ BPRTYPE_", ") D
  1403    . W !!,"D ata fields  VA Ingred ient Cost,  VA Dispen sing Fee,  Ingredient  Cost Paid ,",!
  1404    . W "Disp ensing Fee  Paid and  Patient Re sponsibili ty (INS) w ill only b e included ",!
  1405    . W "when  the repor t is captu red for an  Excel doc ument.  Al l addition al data fi elds",!
  1406    . W "may  not be pre sent for a ll reports ."
  1407    S DIR(0)= "Y",DIR("B ")="NO",DI R("T")=DTI ME W !
  1408    S DIR("A" )="Do you  want to ca pture repo rt data fo r an Excel  document"
  1409    S DIR("?" )="^D HEXC ^BPSRPT4"
  1410    D ^DIR K  DIR I $D(D IRUT)!$D(D TOUT)!$D(D UOUT)!$D(D IROUT) Q " ^"
  1411    K DIROUT, DTOUT,DUOU T,DIRUT
  1412    S EXCEL=0  I Y S EXC EL=1
  1413    ;
  1414    ;Display  Excel disp lay messag e
  1415    I EXCEL=1  D EXMSG
  1416    ;
  1417    Q EXCEL
  1418    
  1419   Modified L ogic (Chan ges are hi ghlighted)
  1420    
  1421   SELEXCEL()  ; - Retur ns whether  to captur e data for  Excel rep ort.
  1422    ; Output:  EXCEL = 1  - YES (ca pture data ) / 0 - NO  (DO NOT c apture dat a)
  1423    ;
  1424    N EXCEL,D IR,DIRUT,D TOUT,DUOUT ,DIROUT
  1425    I ",1,2,3 ,4,"[(","_ BPRTYPE_", ") D
  1426    . W !!,"D ata fields  VA Ingred ient Cost,  VA Dispen sing Fee,  Ingredient  Cost Paid ,",!
  1427    . W "Disp ensing Fee  Paid and  Patient Re sponsibili ty (INS) w ill only b e included ",!
  1428    . W "when  the repor t is captu red for an  Excel doc ument.  Al l addition al data fi elds",!
  1429    . W "may  not be pre sent for a ll reports ."
  1430    I BPRTYPE =7 D
  1431    . W !!,"D ata field  for billed  amount wi ll only be  included  when the r eport is c aptured",!
  1432    . W "for  an Excel d ocument.   All additi onal data  fields may  not be pr esent for  all",!
  1433    . W "repo rts."
  1434    ;
  1435    S DIR(0)= "Y",DIR("B ")="NO",DI R("T")=DTI ME W !
  1436    S DIR("A" )="Do you  want to ca pture repo rt data fo r an Excel  document"
  1437    S DIR("?" )="^D HEXC ^BPSRPT4"
  1438    D ^DIR K  DIR I $D(D IRUT)!$D(D TOUT)!$D(D UOUT)!$D(D IROUT) Q " ^"
  1439    K DIROUT, DTOUT,DUOU T,DIRUT
  1440    S EXCEL=0  I Y S EXC EL=1
  1441    ;
  1442    ;Display  Excel disp lay messag e
  1443    I EXCEL=1  D EXMSG
  1444    ;
  1445    Q EXCEL
  1446    
  1447  
  1448   Modify the  instructi ons for ca pturing to  Excel.
  1449   Subroutine  Name
  1450   EXMSG^BPSR PT4
  1451   Enhancemen t Category
  1452    New
  1453    Modify
  1454    Delete
  1455    No Change
  1456   Current Lo gic
  1457  
  1458    ;Display  the messag e about ca pturing to  an Excel  file forma t ; EXMSG  ; I (",2," )’[BPRTYPE  D
  1459    . W !!?5, "Before co ntinuing,  please set  up your t erminal to  capture t he" . W !? 5,"detail  report dat a. On some  terminals , this can  be done b y" . W !?5 ,"clicking  on the 'T ools' menu  above, th en click o n 'Capture " . W !?5, "Incoming  Data' to s ave to Des ktop.  Thi s report m ay take a"  . W !?5," while to r un." . W ! !?5,"Note:  To avoid  undesired  wrapping o f the data  saved to  the" . W ! ?5," file,  please en ter '0;256 ;999' at t he 'DEVICE :' prompt. ",! E  D
  1460    . W !!?5, "Before co ntinuing,  please set  up your t erminal to  capture t he"
  1461    . W !?5," detail rep ort data a nd save th e detail r eport data  in a text  file"
  1462    . W !?5," to a local  drive.  T his report  may take  a while to  run."
  1463    . W !!?5, "Note: To  avoid unde sired wrap ping of th e data sav ed to the  file,"
  1464    . W !?11, "please en ter '0;256 ;99999' at  the 'DEVI CE:' promp t.",!
  1465    Q
  1466  
  1467  
  1468   Modified L ogic (Chan ges are hi ghlighted)
  1469    
  1470    ;Display  the messag e about ca pturing to  an Excel  file forma t ; EXMSG  ; I (",1,2 ,3,4,7,9," )’[BPRTYPE  D
  1471    . W !!?5, "Before co ntinuing,  please set  up your t erminal to  capture t he" . W !? 5,"detail  report dat a. On some  terminals , this can  be done b y" . W !?5 ,"clicking  on the 'T ools' menu  above, th en click o n 'Capture " . W !?5, "Incoming  Data' to s ave to Des ktop.  Thi s report m ay take a"  . W !?5," while to r un." . W ! !?5,"Note:  To avoid  undesired  wrapping o f the data  saved to  the" . W ! ?5," file,  please en ter '0;256 ;999' at t he 'DEVICE :' prompt. ",! E  D
  1472    . W !!?5, "Before co ntinuing,  please set  up your t erminal to  capture t he"
  1473    . W !?5," detail rep ort data a nd save th e detail r eport data  in a text  file"
  1474    . W !?5," to a local  drive.  T his report  may take  a while to  run."
  1475    . W !!?5, "Note:  To  avoid und esired wra pping of t he data sa ved to the  file,"
  1476    . W !?11, "please en ter '0;256 ;99999' at  the 'DEVI CE:' promp t.",!
  1477    Q
  1478  
  1479  
  1480  
  1481   Modify the  Excel Hea der to abb reviate co lumn headi ngs and ad d/remove s ome column  headings.
  1482  
  1483   Subroutine  Name
  1484   HDR^BPSRPT 8
  1485   Enhancemen t Category
  1486    New
  1487    Modify
  1488    Delete
  1489    No Change
  1490   Current Lo gic
  1491  
  1492    ;Print Ex cel Header  ;HDR(BPRT YPE) ; ; ; Check if h eader alre ady printe d I $G(BPS DATA) Q S  BPSDATA=1  ; ;Divisio n W !,"DIV ISION",U ;  I BPRTYPE '=5,BPRTYP E'=6 W "IN SURANCE",U  I (",2,") [BPRTYPE W  "BIN",U ;  I (",1,3, 4,5,7,8,9, ")[BPRTYPE  W "PATIEN T NAME",U, "Pt.ID",U  ; I (BPRTY PE=1)!(BPR TYPE=4) D   Q . W "EL IGIBILITY" ,U . W "RX #",U . W " REF/ECME#" ,U . W "DA TE",U . W  "VA INGRED IENT COST" ,U . W "VA  DISPENSIN G FEE",U .  W "$BILLE D",U . W " INGREDIENT  COST PAID ",U . W "D ISPENSING  FEE PAID", U . W "PAT IENT RESP  (INS)",U .  W "$INS R ESPONSE",U  . W "$COL LECT",U .  W "DRUG",U  . W "NDC" ,U . W "RE LEASED ON" ,U . W "FI LL LOCATIO N",U . W " FILL TYPE" ,U . W "ST ATUS",U .  I BPRTYPE= 4 W "RX CO B",U . W " REJECTED"  . I BPRTYP E=1 W U,"B ILL#",U,"R X COB" . I  BPRTYPE=4  W U,"REVE RSAL METHO D",U,"RETU RN STATUS" ,U,"REASON " ; I BPRT YPE=2 D  Q  . W "PATI ENT",U . W  "Pt.ID",U  . W "ELIG ",U . W "R X#",U . W  "REF/ECME# ",U . W "D ATE",U . W  "RELEASED ",U . W "L OCATION",U  . W "TYPE ",U . W "S TATUS",U .  W "COB",U  . W "OPEN /CLOSED",U  . W "GROU P ID",U .  W "VA ING.  COST",U .  W "VA DIS P. FEE",U  . W "$BILL ED",U . W  "QTY",U .  W "NDC#",U  . W "DRUG ",U . W "P RESCRIBER  ID",U . W  "PRESCRIBE R",U . W " MULT REJ", U . W "REJ ECT CODE", U . W "REJ ECT EXPLAN ATION" ; I  BPRTYPE=3  D  Q . W  "RX#",U .  W "REF/ECM E#",U . W  "DATE",U .  W "VA ING REDIENT CO ST",U . W  "VA DISPEN SING FEE", U . W "$BI LLED",U .  W "INGREDI ENT COST P AID",U . W  "DISPENSI NG FEE PAI D",U . W " PATIENT RE SP (INS)", U . W "$IN S RESPONSE ",U . W "D RUG",U . W  "NDC",U .  W "FILL L OCATION",U  . W "FILL  TYPE",U .  W "STATUS ",U . W "R X COB",U .  W "REJECT ED" ; I BP RTYPE=5 D   Q . W "RX #",U . W " REF/ECME#" ,U . W "CO MPLETED",U  . W "TRAN S TYPE",U  . W "PAYER  RESPONSE" ,U . W "RX  COB",U .  W "DRUG",U  . W "NDC" ,U . W "FI LL LOCATIO N",U . W " FILL TYPE" ,U . W "ST ATUS",U .  W "REJECTE D",U . W " INSURANCE" ,U . W "EL AP TIME IN  SECONDS"  ; I BPRTYP E=6 D  Q . W "DATE",U  .W "#CLAI MS",U .W " AMOUNT SUB MITTED",U  .W "RETURN ED REJECTE D",U .W "R ETURNED PA YABLE",U . W "AMOUNT  TO RECEIVE ",U .W "DI FFERENCE"  ; I BPRTYP E=7 D  Q .  W "ELIGIB ILITY",U .  W "RX#",U  . W "REF/ ECME#",U .  W "FILL L OCATION",U  . W "FILL  TYPE",U .  W "STATUS ",U . W "R EJECTED",U  . W "DRUG ",U . W "N DC",U . W  "CARDHOLD. ID",U . W  "GROUP ID" ,U . W "$B ILLED",U .  W "CLOSE  DATE/TIME" ,U . W "CL OSED BY",U  . W "CLOS E REASON", U . W "CLA IM ID",U .  W "REJECT  CODE(S)", U . W "REJ ECT CODE", U . W "REJ ECT EXPLAN ATION" ; I  BPRTYPE=8  D  Q . W  "RX#",U .  W "REF/ECM E#",U . W  "DATE",U .  W "$BILLE D",U . W " $INS RESPO NSE",U . W  "$COLLECT ",U . W "D RUG",U . W  "RX INFO" ,U . W "IN S GROUP#", U . W "INS  GROUP NAM E",U . W " BILL#",U .  W "$PROVI DER NETWOR K",U . W " $BRAND DRU G",U . W " $NON-PREF  FORM",U .  W "$BRAND  NON-PREF F ORM",U . W  "$COVERAG E GAP",U .  W "$HEALT H ASST",U  . W "$SPEN D ACCT REM AINING",U  ; I BPRTYP E=9 D  Q .  W "ELIGIB ILITY",U .  W "RX#",U  . W "REF" ,U . W "DA TE",U . W  "$DRUG COS T",U . W " DRUG",U .  W "NDC",U  . W "RELEA SED ON",U  . W "FILL  LOCATION", U . W "STA TUS",U . W  "NON-BILL ABLE STATU S REASON"  Q
  1493  
  1494   Modified L ogic (Chan ges are hi ghlighted)
  1495  
  1496    ;Print Ex cel Header  ;HDR(BPRT YPE) ; ; ; Check if h eader alre ady printe d I $G(BPS DATA) Q S  BPSDATA=1  ; ;Divisio n W !,"DIV ISION",U ;  I BPRTYPE '=5,BPRTYP E'=6 W "IN SURANCE",U  I (",2,") [BPRTYPE W  "BIN",U ;  I (",1,3, 4,5,7,8,9, ")[BPRTYPE  W "PATIEN T NAME",U, "Pt.ID",U
  1497    I (",1,2, 3,4,7,9,") [BPRTYPE W  "PATIENT" ,U,"Pt.ID" ,U ;
  1498    ;  I (BPR TYPE=1)!(B PRTYPE=4)  D  Q . W " ELIGIBILIT Y",U . W " RX#",U . W  "REF/ECME #",U . W " DATE",U .  W "VA INGR EDIENT COS T",U . W " VA DISPENS ING FEE",U  . W "$BIL LED",U . W  "INGREDIE NT COST PA ID",U . W  "DISPENSIN G FEE PAID ",U . W "P ATIENT RES P (INS)",U  . W "$INS  RESPONSE" ,U . W "$C OLLECT",U  . W "DRUG" ,U . W "ND C",U . W " RELEASED O N",U . W " FILL LOCAT ION",U . W  "FILL TYP E",U . W " STATUS",U  . I BPRTYP E=4 W "RX  COB",U . W  "REJECTED " . I BPRT YPE=1 W U, "BILL#",U, "RX COB" .  I BPRTYPE =4 W U,"RE VERSAL MET HOD",U,"RE TURN STATU S",U,"REAS ON"
  1499    I BPRTYPE =1 D  Q
  1500    . W "ELIG ",U
  1501    . W "RX#" ,U
  1502    . W "REF/ ECME#",U
  1503    . W "DATE ",U
  1504    . W "VA I NG. COST", U
  1505    . W "VA D ISP. FEE", U
  1506    . W "$BIL LED",U
  1507    . W "INGR EDIENT COS T PAID",U
  1508    . W "DISP ENSING FEE  PAID",U
  1509    . W "PATI ENT RESP ( INS)",U
  1510    . W "$INS  RESPONSE" ,U
  1511    . W "$COL LECT",U
  1512    . W "DRUG ",U
  1513    . W "NDC" ,U
  1514    . W "RELE ASED",U
  1515    . W "LOCA TION",U
  1516    . W "TYPE ",U
  1517    . W "STAT US",U
  1518    . W "REJE CTED",U
  1519    . W "BILL #",U
  1520    . W "COB"
  1521    ;
  1522    I BPRTYPE =4 D  Q
  1523    . W "ELIG ",U
  1524    . W "RX#" ,U
  1525    . W "REF/ ECME#",U
  1526    . W "DATE ",U
  1527    . W "VA I NG. COST", U
  1528    . W "VA D ISP. FEE", U
  1529    . W "$BIL LED",U
  1530    . W "ING.  COST PAID ",U
  1531    . W "DIS.  FEE PAID" ,U
  1532    . W "PATI ENT RESP ( INS)",U
  1533    . W "$INS  RESPONSE" ,U
  1534    . W "$COL LECT",U
  1535    . W "DRUG ",U
  1536    . W "NDC" ,U
  1537    . W "RELE ASED",U
  1538    . W "LOCA TION",U
  1539    . W "TYPE ",U
  1540    . W "STAT US",U
  1541    . W "COB" ,U
  1542    . W "REJE CTED",U
  1543    . W "REVE RSAL METHO D",U
  1544    . W "RETU RN STATUS" ,U
  1545    . W "REAS ON"
  1546    ; I BPRTY PE=2 D  Q  . W "PATIE NT",U . W  "Pt.ID",U  . W "ELIG" ,U . W "RX #",U . W " REF/ECME#" ,U . W "DA TE",U . W  "RELEASED" ,U . W "LO CATION",U  . W "TYPE" ,U . W "ST ATUS",U .  W "COB",U  . W "OPEN/ CLOSED",U  . W "GROUP  ID",U . W  "VA ING.  COST",U .  W "VA DISP . FEE",U .  W "$BILLE D",U . W " QTY",U . W  "NDC#",U  . W "DRUG" ,U . W "PR ESCRIBER I D",U . W " PRESCRIBER ",U . W "M ULT REJ",U  . W "REJE CT CODE",U  . W "REJE CT EXPLANA TION" ; I  BPRTYPE=3  D  Q . W " RX#",U . W  "REF/ECME #",U . W " DATE",U .  W "VA ING. REDIENT CO ST",U . W  "VA DIS.PE NSING FEE" ,U . W "$B ILLED",U .  W "INGRED IENT COST  PAID",U .  W "DISPENS ING FEE PA ID",U . W  "PATIENT R ESP (INS)" ,U . W "$I NS RESPONS E",U . W " DRUG",U .  W "NDC",U  . W "FILL  LOCATION", U . W "FIL L TYPE",U  . W "STATU S",U . W " RX COB",U
  1547    . W "ELIG ",U . W "R EJECTED" ;  I BPRTYPE =5 D  Q .  W "RX#",U  . W "REF/E CME#",U .  W "COMPLET ED",U . W  "TRANS TYP E",U . W " PAYER RESP ONSE",U .  W "RX COB" ,U . W "DR UG",U . W  "NDC",U .  W "FILL LO CATION",U  . W "FILL  TYPE",U .  W "STATUS" ,U . W "RE JECTED",U  . W "INSUR ANCE",U .  W "ELAP TI ME IN SECO NDS" ; I B PRTYPE=6 D   Q .W "DA TE",U .W " #CLAIMS",U  .W "AMOUN T SUBMITTE D",U .W "R ETURNED RE JECTED",U  .W "RETURN ED PAYABLE ",U .W "AM OUNT TO RE CEIVE",U . W "DIFFERE NCE" ; I B PRTYPE=7 D   Q . W "E LIGIBILITY ",U . W "R X#",U . W  "REF/ECME# ",U . W "F ILL LOCATI ON",U . W  "FILL TYPE ",U . W "S TATUS",U .  W "REJECT ED",U . W  "DRUG",U .  W "NDC",U  . W "CARD HOLD.ID",U  . W "GROU P ID",U .  W "$BILLED ",U . W "C LOSE DATE/ TIME",U .  W "CLOSED  BY",U . W  "CLOSE REA SON",U . W  "CLAIM ID ",U . W "R EJECT CODE (S)",U
  1548    . W "MULT  REJ",U .  W "REJECT  CODE",U .  W "REJECT  EXPLANATIO N" ; I BPR TYPE=8 D   Q . W "RX# ",U . W "R EF/ECME#", U . W "DAT E",U . W " $BILLED",U  . W "$INS  RESPONSE" ,U . W "$C OLLECT",U  . W "DRUG" ,U . W "RX  INFO",U .  W "INS GR OUP#",U .  W "INS GRO UP NAME",U  . W "BILL #",U . W " $PROVIDER  NETWORK",U  . W "$BRA ND DRUG",U  . W "$NON -PREF FORM ",U . W "$ BRAND NON- PREF FORM" ,U . W "$C OVERAGE GA P",U . W " $HEALTH AS ST",U . W  "$SPEND AC CT REMAINI NG",U ; I  BPRTYPE=9  D  Q . W " ELIGIBILIT Y",U . W " RX#",U . W  "REF",U .  W "DATE", U . W "$DR UG COST",U  . W "DRUG ",U . W "N DC",U . W  "RELEASED  ON",U . W  "FILL LOCA TION",U .  W "STATUS" ,U . W "NO N-BILLABLE  STATUS RE ASON" Q
  1549  
  1550     
  1551  
  1552   Modify the  Excel Hea der to abb reviate co lumn headi ngs and ad d/remove s ome column  headings.
  1553   Modify the  Excel out put trunca ting some  data field s, adding  and removi ng other c olumn head ings.  For  several o f the repo rts limit  the line l ength to 2 55 charact ers to avo id wrappin g of the l ines of da ta in the  Excel form at.
  1554     
  1555   Subroutine  Name
  1556   WRLINE1^BP SRPT8
  1557   Enhancemen t Category
  1558    New
  1559    Modify
  1560    Delete
  1561    No Change
  1562   Current Lo gic
  1563    
  1564    ;Routine  to Display  the Repor ts in Exce l ; ;Print  Report Li ne 1 ; ; I nput Varia ble -> BPR TYPE,BPDIV ,BPGRPLAN, BPDFN,BPRX ,BPREF,BPX ,BPSRTDT ;  BPBIL,BPI NS,BPCOLL  ; WRLINE1( BPRTYPE,BP REC,BPDIV, BPGRPLAN,B PDFN,BPRX, BPREF,BPX, BPSRTDT,BP BIL,BPINS, BPCOLL,BPP SEQ) ; ; N  BP59,BP02 ,BP03 S BP 59=$P(BPX, U,3) S BP0 2=+$P($G(^ BPST(BP59, 0)),U,4) S  BP03=+$P( $G(^BPST(B P59,0)),U, 5) ;Divisi on I (",2, ")'[BPRTYP E S BPREC= $S(BPDIV=0 :"BLANK",$ $DIVNAME^B PSSCRDS(BP DIV)]"":$$ DIVNAME^BP SSCRDS(BPD IV),1:BPDI V)_U I (", 2,")[BPRTY PE S BPREC =$S(BPDIV= 0:"BLANK", $$DIVNAME^ BPSSCRDS(B PDIV)]"":$ E($$DIVNAM E^BPSSCRDS (BPDIV),1, 12),1:$E(B PDIV,1,12) )_U ; ;Ins urance I B PRTYPE'=5, BPRTYPE'=6 ,BPRTYPE'= 2 S BPREC= BPREC_$E(B PGRPLAN,1, 90)_U ; I  (",2")[BPR TYPE D . S  BPREC=BPR EC_$E(BPGR PLAN,1,21) _U ;Insura nce . S BP REC=BPREC_ $$INSBIN^B PSRPT6(BP5 9)_U ;BIN  . S BPREC= BPREC_$E($ $PATNAME^B PSRPT6(BPD FN),1,13)_ U  ;Patien t Name . S  BPREC=BPR EC_$$SSN4^ BPSRPT6(BP DFN)_U ;L4 SSN ; I (" ,2,")'[BPR TYPE D . S  BPREC=BPR EC_$$PATNA ME^BPSRPT6 (BPDFN)_U   ;Patient  Name . S B PREC=BPREC _"("_$$SSN 4^BPSRPT6( BPDFN)_")" _U ;L4SSN  ; I (BPRTY PE=1)!(BPR TYPE=4) D   Q . N PTR ESP . S BP REC=BPREC_ $$ELIGCODE ^BPSSCR05( $P(BPX,U,3 ))_U ;Elig ibility .  S BPREC=BP REC_$$RXNU M^BPSRPT6( BPRX)_$$CO PAY^BPSRPT 6(BPRX)_U  ;RX Number  . S BPREC =BPREC_BPR EF_"/"_$$E CMENUM^BPS RPT1($P(BP X,U,3))_U  ;Refill/EC ME Number  . S BPREC= BPREC_$$DA TTIM^BPSRP T1(BPSRTDT )_U  ;Date  . S BPREC =BPREC_$$I NGRCST^BPS SCRLG(BP02 )_U  ;Ingr edient Cos t . S BPRE C=BPREC_$$ DISPFEE^BP SSCRLG(BP0 2)_U  ;Dis pensing Fe e . S BPRE C=BPREC_$T R($J(BPBIL ,10,2)," " )_U ;$Bill ed . S BPR EC=BPREC_$ $ICPAID^BP SSCRLG(BP0 3)_U  ;Ing redient Co st Paid .  S BPREC=BP REC_$$DFPA ID^BPSSCRL G(BP03)_U   ;Dispensi ng Fee Pai d . S PTRE SP=$$PTRES P^BPSSCRLG (BP03) S B PREC=BPREC _$S('PTRES P:PTRESP,1 :"-"_PTRES P)_U  ;Pat ient Pay A mount . S  BPREC=BPRE C_$TR($J(B PINS,10,2) ," ")_U ;$ Ins. Paid  . S BPREC= BPREC_$S(B PCOLL]"":$ TR($J(BPCO LL,10,2),"  "),1:"")_ U ;$Collec ted ; I BP RTYPE=2 D   Q . S BPR EC=BPREC_$ $ELIGCODE^ BPSSCR05($ P(BPX,U,3) )_U ;Eligi bility . S  BPREC=BPR EC_$$RXNUM ^BPSRPT6(B PRX)_$$COP AY^BPSRPT6 (BPRX)_U ; RX Number  . S BPREC= BPREC_BPRE F_"/"_$$EC MENUM^BPSR PT1($P(BPX ,U,3))_U ; Refill/ECM E Number .  S BPREC=B PREC_$$DAT TIM^BPSRPT 1(BPSRTDT) _U ;Date .  S BPREC=B PREC_$$DAT TIM^BPSRPT 1(+BPX)_U   ;Released  On . ;RX  INFO . S B PREC=BPREC _$$MWC^BPS RPT6(BPRX, BPREF)_U ; Fill Locat ion . S BP REC=BPREC_ $$RTBCKNAM ^BPSRPT1($ $RTBCK^BPS RPT1($P(BP X,U,3)))_U   ;Fill Ty pe . S BPR EC=BPREC_$ $RXSTATUS^ BPSRPT6($P (BPX,U,3))  ;Status .  S BPREC=B PREC_$S($P (BPX,U):"/ R",1:"/N") _U ;RL/NR  . S BPREC= BPREC_$$RX COB($G(BPP SEQ))_U .  S BPREC=BP REC_$S($$C LOSED02^BP SSCR03($P( ^BPST($P(B PX,U,3),0) ,U,4))=1:" C",1:"O")_ U ;Open/Cl osed ; I B PRTYPE=3 D   Q . N PT RESP . S B PREC=BPREC _$$RXNUM^B PSRPT6(BPR X)_$$COPAY ^BPSRPT6(B PRX)_U ;RX  Number .  S BPREC=BP REC_BPREF_ "/"_$$ECME NUM^BPSRPT 1($P(BPX,U ,3))_U ;Re fill/ECME  Number . S  BPREC=BPR EC_$$DATTI M^BPSRPT1( BPSRTDT)_U  ;Date . S  BPREC=BPR EC_$$INGRC ST^BPSSCRL G(BP02)_U   ;Ingredie nt Cost .  S BPREC=BP REC_$$DISP FEE^BPSSCR LG(BP02)_U   ;Dispens ing Fee .  S BPREC=BP REC_$TR($J (BPBIL,10, 2)," ")_U  ;$Billed .  S BPREC=B PREC_$$ICP AID^BPSSCR LG(BP03)_U   ;Ingredi ent Cost P aid . S BP REC=BPREC_ $$DFPAID^B PSSCRLG(BP 03)_U  ;Di spensing F ee Paid .  S PTRESP=$ $PTRESP^BP SSCRLG(BP0 3) S BPREC =BPREC_$S( 'PTRESP:PT RESP,1:"-" _PTRESP)_U   ;Patient  Pay Amoun t . S BPRE C=BPREC_$T R($J(BPINS ,10,2)," " )_U ;Insur ance Respo nse ; I BP RTYPE=5 D   Q . S BPR EC=BPREC_$ $RXNUM^BPS RPT6(BPRX) _$$COPAY^B PSRPT6(BPR X)_U ;RX N umber . S  BPREC=BPRE C_BPREF_"/ "_$$ECMENU M^BPSRPT1( $P(BPX,U,3 ))_U ;Refi ll/ECME Nu mber . S B PREC=BPREC _$$DATTIM^ BPSRPT1($$ TRANDT^BPS RPT2($P(BP X,U,3),1)) _U ;Comple ted . S BP REC=BPREC_ $$TTYPE^BP SRPT7($P(B PX,U,4),$P (BPX,U,5), BPPSEQ)_U  ;Trans Typ e . S BPRE C=BPREC_$$ RESPONSE^B PSRPT7($P( BPX,U,4),$ P(BPX,U,5) ,BPPSEQ)_U  ;Payer Re sponse . S  BPREC=BPR EC_$$RXCOB ($G(BPPSEQ ))_U ;RX C OB ; I BPR TYPE=7 D   Q . ;RX IN FO . S BPR EC=BPREC_$ $ELIGCODE^ BPSSCR05($ P(BPX,U,3) )_U ;Eligi bility . S  BPREC=BPR EC_$$RXNUM ^BPSRPT6(B PRX)_$$COP AY^BPSRPT6 (BPRX)_U ; RX Number  . S BPREC= BPREC_BPRE F_"/"_$$EC MENUM^BPSR PT1($P(BPX ,U,3))_U ; Refill/ECM E Number .  S BPREC=B PREC_$$MWC ^BPSRPT6(B PRX,BPREF) _U ;Fill L ocation .  S BPREC=BP REC_$$RTBC KNAM^BPSRP T1($$RTBCK ^BPSRPT1($ P(BPX,U,3) ))_U ;Fill  Type . S  BPREC=BPRE C_$$RXSTAT US^BPSRPT6 ($P(BPX,U, 3)) ;Statu s . S BPRE C=BPREC_$S ($P(BPX,U) :"/R",1:"/ N")_U ;RL/ NR . S BPR EC=BPREC_$ S($P(BPX,U ,13):"REJ" ,1:"")_U .  S BPREC=B PREC_$$DRG NAM^BPSRPT 6($P(BPX,U ,14),32)_U  ;Drug . S  BPREC=BPR EC_$TR($$G ETNDC^BPSR PT6(BPRX,B PREF),"-") _U ; I (BP RTYPE=8) D   Q . S BP REC=BPREC_ $$RXNUM^BP SRPT6(BPRX )_$$COPAY^ BPSRPT6(BP RX)_U ;RX  Number . S  BPREC=BPR EC_BPREF_" /"_$$ECMEN UM^BPSRPT1 ($P(BPX,U, 3))_U ;Ref ill/ECME N umber . S  BPREC=BPRE C_$$DATTIM ^BPSRPT1(B PSRTDT)_U   ;Date . S  BPREC=BPR EC_$TR($J( BPBIL,10,2 )," ")_U ; $Billed .  S BPREC=BP REC_$TR($J (BPINS,10, 2)," ")_U  ;$Ins. Pai d . S BPRE C=BPREC_$S (BPCOLL]"" :$TR($J(BP COLL,10,2) ," "),1:"" )_U ;$Coll ected ; I  BPRTYPE=9  D  Q . N E LGCD S ELG CD=$P(BPX, U,1) . S B PREC=BPREC _$S(ELGCD= "V":"VET", ELGCD="T": "TRI",ELGC D="C":"CVA ",1:"UNK") _U . S BPR EC=BPREC_$ $RXNUM^BPS RPT6(BPRX) _$$COPAY^B PSRPT6(BPR X)_U ;RX N umber . S  BPREC=BPRE C_BPREF_U                         ;Refill .  S BPREC=B PREC_$$DAT
  1565   TIM^BPSRPT 1(BPSRTDT) _U  ;Date  . S BPREC= BPREC_$S($ P(BPX,U,2) ]"":$TR($J ($P(BPX,U, 2),10,2),"  "),1:"")_ U ;$Drug C ost Q
  1566  
  1567   Modified L ogic (Chan ges are hi ghlighted)
  1568  
  1569    ;Routine  to Display  the Repor ts in Exce l ; ;Print  Report Li ne 1 ; ; I nput Varia ble -> BPR TYPE,BPDIV ,BPGRPLAN, BPDFN,BPRX ,BPREF,BPX ,BPSRTDT ;  BPBIL,BPI NS,BPCOLL  ; WRLINE1( BPRTYPE,BP REC,BPDIV, BPGRPLAN,B PDFN,BPRX, BPREF,BPX, BPSRTDT,BP BIL,BPINS, BPCOLL,BPP SEQ) ; ; N  BP59,BP02 ,BP03,BPRE C2 S BP59= $P(BPX,U,3 ) S BP02=+ $P($G(^BPS T(BP59,0)) ,U,4) S BP 03=+$P($G( ^BPST(BP59 ,0)),U,5)  ;Division  I (",2,5,6 ,8,")'[BPR TYPE S BPR EC=$S(BPDI V=0:"BLANK ",$$DIVNAM E^BPSSCRDS (BPDIV)]"" :$$DIVNAME ^BPSSCRDS( BPDIV),1:B PDIV)_U I  (",1,2,3,4 ,7,9,")[BP RTYPE S BP REC=$S(BPD IV=0:"BLAN K",$$DIVNA ME^BPSSCRD S(BPDIV)]" ":$E($$DIV NAME^BPSSC RDS(BPDIV) ,1,12),1:$ E(BPDIV,1, 12))_U ; ; Insurance  I BPRTYPE' =5,BPRTYPE '=6,BPRTYP E'=2BPRTYP E=8 S BPRE C=BPREC_$E (BPGRPLAN, 1,90)_U ;  I (",1,2,3 ,4,7,9,")[ BPRTYPE D  . S BPREC= BPREC_$E(B PGRPLAN,1, 21)_U ;Ins urance . I  BPRTYPE=2  S BPREC=B PREC_$$INS BIN^BPSRPT 6(BP59)_U  ;BIN . S B PREC=BPREC _$E($$PATN AME^BPSRPT 6(BPDFN),1 ,13)_U  ;P atient Nam e . S BPRE C=BPREC_$$ SSN4^BPSRP T6(BPDFN)_ U ;L4SSN ;  I (",25,6 ,8,")'[BPR TYPE D . S  BPREC=BPR EC_$$PATNA ME^BPSRPT6 (BPDFN)_U   ;Patient  Name . S B PREC=BPREC _"("_$$SSN 4^BPSRPT6( BPDFN)_")" _U ;L4SSN  ; I (BPRTY PE=1)!(BPR TYPE=4) D   Q . N PTR ESP . S BP REC=BPREC_ $$ELIGCODE ^BPSSCR05( $P(BPX,U,3 ))_U ;Elig ibility .  S BPREC=BP REC_$$RXNU M^BPSRPT6( BPRX)_$$CO PAY^BPSRPT 6(BPRX)_U  ;RX Number  . S BPREC =BPREC_BPR EF_"/"_$$E CMENUM^BPS RPT1($P(BP X,U,3))_U  ;Refill/EC ME Number  . S BPREC= BPREC_$$DA TTIM^BPSRP T1(BPSRTDT )_U  ;Date  . S BPREC =BPREC_$$I NGRCST^BPS SCRLG(BP02 )_U  ;Ingr edient Cos t . S BPRE C=BPREC_$$ DISPFEE^BP SSCRLG(BP0 2)_U  ;Dis pensing Fe e . S BPRE C=BPREC_$T R($J(BPBIL ,10,2)," " )_U ;$Bill ed . S BPR EC=BPREC_$ $ICPAID^BP SSCRLG(BP0 3)_U  ;Ing redient Co st Paid .  S BPREC=BP REC_$$DFPA ID^BPSSCRL G(BP03)_U   ;Dispensi ng Fee Pai d . S PTRE SP=$$PTRES P^BPSSCRLG (BP03) S B PREC=BPREC _$S('PTRES P:PTRESP,1 :"-"_PTRES P)_U  ;Pat ient Pay A mount . S  BPREC=BPRE C_$TR($J(B PINS,10,2) ," ")_U ;$ Ins. Paid  . S BPREC= BPREC_$S(B PCOLL]"":$ TR($J(BPCO LL,10,2),"  "),1:"")_ U ;$Collec ted ; I BP RTYPE=2 D   Q . S BPR EC=BPREC_$ $ELIGCODE^ BPSSCR05($ P(BPX,U,3) )_U ;Eligi bility . S  BPREC=BPR EC_$$RXNUM ^BPSRPT6(B PRX)_$$COP AY^BPSRPT6 (BPRX)_U ; RX Number  . S BPREC= BPREC_BPRE F_"/"_$$EC MENUM^BPSR PT1($P(BPX ,U,3))_U ; Refill/ECM E Number .  S BPREC=B PREC_$$DAT TIM^BPSRPT 1(BPSRTDT) _U ;Date .  S BPREC=B PREC_$$DAT TIM^BPSRPT 1(+BPX)_U   ;Released  On . ;RX  INFO . S B PREC=BPREC _$$MWC^BPS RPT6(BPRX, BPREF)_U ; Fill Locat ion . S BP REC=BPREC_ $$RTBCKNAM ^BPSRPT1($ $RTBCK^BPS RPT1($P(BP X,U,3)))_U   ;Fill Ty pe . S BPR EC=BPREC_$ $RXSTATUS^ BPSRPT6($P (BPX,U,3))  ;Status .  S BPREC=B PREC_$S($P (BPX,U):"/ R",1:"/N") _U ;RL/NR  . S BPREC= BPREC_$$RX COB($G(BPP SEQ))_U .  S BPREC=BP REC_$S($$C LOSED02^BP SSCR03($P( ^BPST($P(B PX,U,3),0) ,U,4))=1:" C",1:"O")_ U ;Open/Cl osed ; I B PRTYPE=3 D   Q . N PT RESP . S B PREC=BPREC _$$RXNUM^B PSRPT6(BPR X)_$$COPAY ^BPSRPT6(B PRX)_U ;RX  Number .  S BPREC=BP REC_BPREF_ "/"_$$ECME NUM^BPSRPT 1($P(BPX,U ,3))_U ;Re fill/ECME  Number . S  BPREC=BPR EC_$$DATTI M^BPSRPT1( BPSRTDT)_U  ;Date . S  BPREC=BPR EC_$$INGRC ST^BPSSCRL G(BP02)_U   ;Ingredie nt Cost .  S BPREC=BP REC_$$DISP FEE^BPSSCR LG(BP02)_U   ;Dispens ing Fee .  S BPREC=BP REC_$TR($J (BPBIL,10, 2)," ")_U  ;$Billed .  S BPREC=B PREC_$$ICP AID^BPSSCR LG(BP03)_U   ;Ingredi ent Cost P aid . S BP REC=BPREC_ $$DFPAID^B PSSCRLG(BP 03)_U  ;Di spensing F ee Paid .  S PTRESP=$ $PTRESP^BP SSCRLG(BP0 3) S BPREC =BPREC_$S( 'PTRESP:PT RESP,1:"-" _PTRESP)_U   ;Patient  Pay Amoun t . S BPRE C=BPREC_$T R($J(BPINS ,10,2)," " )_U ;Insur ance Respo nse ; I BP RTYPE=5 D   Q . S BPR EC=BPREC_$ $RXNUM^BPS RPT6(BPRX) _$$COPAY^B PSRPT6(BPR X)_U ;RX N umber . S  BPREC=BPRE C_BPREF_"/ "_$$ECMENU M^BPSRPT1( $P(BPX,U,3 ))_U ;Refi ll/ECME Nu mber . S B PREC=BPREC _$$DATTIM^ BPSRPT1($$ TRANDT^BPS RPT2($P(BP X,U,3),1)) _U ;Comple ted . S BP REC=BPREC_ $$TTYPE^BP SRPT7($P(B PX,U,4),$P (BPX,U,5), BPPSEQ)_U  ;Trans Typ e . S BPRE C=BPREC_$$ RESPONSE^B PSRPT7($P( BPX,U,4),$ P(BPX,U,5) ,BPPSEQ)_U  ;Payer Re sponse . S  BPREC=BPR EC_$$RXCOB ($G(BPPSEQ ))_U ;RX C OB ; I BPR TYPE=7 D   Q . ;RX IN FO . S BPR EC=BPREC_$ $ELIGCODE^ BPSSCR05($ P(BPX,U,3) )_U ;Eligi bility . S  BPREC=BPR EC_$$RXNUM ^BPSRPT6(B PRX)_$$COP AY^BPSRPT6 (BPRX)_U ; RX Number  . S BPREC= BPREC_BPRE F_"/"_$$EC MENUM^BPSR PT1($P(BPX ,U,3))_U ; Refill/ECM E Number .  S BPREC=B PREC_$$MWC ^BPSRPT6(B PRX,BPREF) _U ;Fill L ocation .  S BPREC=BP REC_$$RTBC KNAM^BPSRP T1($$RTBCK ^BPSRPT1($ P(BPX,U,3) ))_U ;Fill  Type . S  BPREC=BPRE C_$$RXSTAT US^BPSRPT6 ($P(BPX,U, 3)) ;Statu s . S BPRE C=BPREC_$S ($P(BPX,U) :"/R",1:"/ N")_U ;RL/ NR . S BPR EC=BPREC_$ S($P(BPX,U ,13):"REJ" ,1:"")_U .  S BPREC=B PREC_$$DRG NAM^BPSRPT 6($P(BPX,U ,14),3215) _U ;Drug .  S BPREC=B PREC_$TR($ $GETNDC^BP SRPT6(BPRX ,BPREF),"- ")_U ; I ( BPRTYPE=8)  D  Q . S  BPREC=BPRE C_$$RXNUM^ BPSRPT6(BP RX)_$$COPA Y^BPSRPT6( BPRX)_U ;R X Number .  S BPREC=B PREC_BPREF _"/"_$$ECM ENUM^BPSRP T1($P(BPX, U,3))_U ;R efill/ECME  Number .  S BPREC=BP REC_$$DATT IM^BPSRPT1 (BPSRTDT)_ U  ;Date .  S BPREC=B PREC_$TR($ J(BPBIL,10 ,2)," ")_U  ;$Billed  . S BPREC= BPREC_$TR( $J(BPINS,1 0,2)," ")_ U ;$Ins. P aid . S BP REC=BPREC_ $S(BPCOLL] "":$TR($J( BPCOLL,10, 2)," "),1: "")_U ;$Co llected ;  I BPRTYPE= 9 D  Q . N  ELGCD S E LGCD=$P(BP X,U,1) . S  BPREC=BPR EC_$S(ELGC D="V":"VET ",ELGCD="T ":"TRI",EL GCD="C":"C VA",1:"UNK ")_U . S B PREC=BPREC _$$RXNUM^B PSRPT6(BPR X)_$$COPAY ^BPSRPT6(B PRX)_U ;RX  Number .  S BPREC=BP
  1570   REC_BPREF_ U                        ;Refill  . S BPREC =BPREC_$$D ATTIM^BPSR PT1(BPSRTD T)_U  ;Dat e . S BPRE C=BPREC_$S ($P(BPX,U, 2)]"":$TR( $J($P(BPX, U,2),10,2) ," "),1:"" )_U ;$Drug  Cost Q
  1571  
  1572  
  1573  
  1574   Subroutine  Name
  1575   WRLINE2^BP SRPT8
  1576   Enhancemen t Category
  1577    New
  1578    Modify
  1579    Delete
  1580    No Change
  1581   Current Lo gic
  1582  
  1583    ;Print Re port Line  2 ; ; Inpu t Variable  -> BPRTYP E,BPX,BPRX ,BPREF,BPB IL,BPGRPLA N ; WRLINE 2(BPRTYPE, BPREC,BPX, BPRX,BPREF ,BPBIL,BPG RPLAN,BPPS EQ) ; N BP 59,BP02 S  BP59=$P(BP X,U,3) S B P02=+$P($G (^BPST(BP5 9,0)),U,4)  ; I (BPRT YPE=1)!(BP RTYPE=4) D   Q . ;Dru g, Release d On . S B PREC=BPREC _$$DRGNAM^ BPSRPT6($P (BPX,U,14) ,32)_U_$TR ($$GETNDC^ BPSRPT6(BP RX,BPREF), "-")_U . S  BPREC=BPR EC_$$DATTI M^BPSRPT1( +BPX)_U .  ;RX INFO .  S BPREC=B PREC_$$MWC ^BPSRPT6(B PRX,BPREF) _U ;Fill L ocation .  S BPREC=BP REC_$$RTBC KNAM^BPSRP T1($$RTBCK ^BPSRPT1($ P(BPX,U,3) ))_U ;Fill  Type . S  BPREC=BPRE C_$$RXSTAT US^BPSRPT6 ($P(BPX,U, 3)) ;Statu s . S BPRE C=BPREC_$S ($P(BPX,U) :"/R",1:"/ N")_U ;RL/ NR . I BPR TYPE=4 S B PREC=BPREC _$$RXCOB($ G(BPPSEQ)) _U . S BPR EC=BPREC_$ S($P(BPX,U ,13):"REJ" ,1:"") . I  BPRTYPE=1  S BPREC=B PREC_U_$$B ILL^BPSRPT 6(BPRX,BPR EF,BPPSEQ) _U_$$RXCOB ($G(BPPSEQ )) ;Bill #  and RX CO B ; I BPRT YPE=2 D  Q  . S BPREC =BPREC_$E( $$GRPID^BP SRPT2(+$P( BPX,U,3)), 3,10)_U ;G roup ID .  S BPREC=BP REC_$$INGR CST^BPSSCR LG(BP02)_U   ;Ingredi ent Cost .  S BPREC=B PREC_$$DIS PFEE^BPSSC RLG(BP02)_ U  ;Dispen sing Fee .  S BPREC=B PREC_$TR($ J(BPBIL,10 ,2)," ")_U  ;$Billed  . S BPREC= BPREC_$$QT Y^BPSRPT6( $P(BPX,U,3 ))_U ;Qty  . S BPREC= BPREC_$$GE TNDC^BPSRP T6(BPRX,BP REF)_U ;ND C# . S BPR EC=BPREC_$ E($$DRGNAM ^BPSRPT6($ P(BPX,U,14 ),32),1,15 )_U ;Drug  ; I BPRTYP E=3 D  Q .  S BPREC=B PREC_$$DRG NAM^BPSRPT 6($P(BPX,U ,14),32)_U  ;Drug . S  BPREC=BPR EC_$TR($$G ETNDC^BPSR PT6(BPRX,B PREF),"-") _U . ;RX I NFO . S BP REC=BPREC_ $$MWC^BPSR PT6(BPRX,B PREF)_U ;F ill Locati on . S BPR EC=BPREC_$ $RTBCKNAM^ BPSRPT1($$ RTBCK^BPSR PT1($P(BPX ,U,3)))_U  ;Fill Type  . S BPREC =BPREC_$$R XSTATUS^BP SRPT6($P(B PX,U,3)) ; Status . S  BPREC=BPR EC_$S($P(B PX,U):"/R" ,1:"/N")_U  ;RL/NR .  S BPREC=BP REC_$$RXCO B($G(BPPSE Q))_U . S  BPREC=BPRE C_$S($P(BP X,U,13):"R EJ",1:"")  ; I BPRTYP E=5 D  Q .  S BPREC=B PREC_$$DRG NAM^BPSRPT 6($P(BPX,U ,14),32)_U  ;Drug . S  BPREC=BPR EC_$TR($$G ETNDC^BPSR PT6(BPRX,B PREF),"-") _U . ;RX I NFO . S BP REC=BPREC_ $$MWC^BPSR PT6(BPRX,B PREF)_U ;F ill Locati on . S BPR EC=BPREC_$ $RTBCKNAM^ BPSRPT1($$ RTBCK^BPSR PT1($P(BPX ,U,3)))_U  ;Fill Type  . S BPREC =BPREC_$$R XSTATUS^BP SRPT6($P(B PX,U,3)) ; Status . S  BPREC=BPR EC_$S($P(B PX,U):"/R" ,1:"/N")_U  ;RL/NR .  S BPREC=BP REC_$S($P( BPX,U,13): "REJ",1:"" )_U . I $P (BPGRPLAN, U,2)]"" S  BPREC=BPRE C_$E($P(BP GRPLAN,U,2 ),1,30) ;I nsurance .  S BPREC=B PREC_U_$$E LAPSE^BPSR PT6($P(BPX ,U,3)) ;El apsed Time  ; I BPRTY PE=7 D  Q  . S BPREC= BPREC_$E($ $CRDHLDID^ BPSRPT2(+$ P(BPX,U,3) ),3,23)_U  ;Cardholde r ID . S B PREC=BPREC _$E($$GRPI D^BPSRPT2( +$P(BPX,U, 3)),3,10)_ U  ;Group  ID . S BPR EC=BPREC_$ TR($J(BPBI L,10,2),"  ")_U ;$Bil led . S BP REC=BPREC_ $$DATTIM^B PSRPT1(+$$ CLOSEDT^BP SRPT2(+$P( BPX,U,3))) _U ;Close  Dt/Time .  S BPREC=BP REC_$E($$C LSBY^BPSRP T6(+$P(BPX ,U,3)),1,2 5)_U ;Clos e By . S B PREC=BPREC _$E($P($$C LRSN^BPSRP T7(+$P(BPX ,U,3)),U,2 ),1,30)_U  ;Close Rea son ; I BP RTYPE=8 D   Q . S BPR EC=BPREC_$ $DRGNAM^BP SRPT6($P(B PX,U,14),2 7)_U ;Drug  . S BPREC =BPREC_$$M WC^BPSRPT6 (BPRX,BPRE F)_" " ;Fi ll Locatio n . S BPRE C=BPREC_$$ RTBCKNAM^B PSRPT1($$R TBCK^BPSRP T1($P(BPX, U,3)))_" "  ;Fill Typ e . S BPRE C=BPREC_$$ RXSTATUS^B PSRPT6($P( BPX,U,3))  ;Status .  S BPREC=BP REC_$S($P( BPX,U):"/R ",1:"/N")_ U ;RL/NR .  S BPREC=B PREC_$TR($ E($$GRPID^ BPSRPT2(+$ P(BPX,U,3) ),3,10),"  ","")_U  ; Group ID .  S BPREC=B PREC_$E(BP GRPLAN,1,3 0)_U ;Insu rance . S  BPREC=BPRE C_$$BILL^B PSRPT6(BPR X,BPREF,BP PSEQ)_U ;B ill# ; I B PRTYPE=9 D   Q . S BP REC=BPREC_ $$DRGNAM^B PSRPT6($P( BPX,U,4),3 2)_U  ;Dru g . S BPRE C=BPREC_$T R($$GETNDC ^BPSRPT6(B PRX,BPREF) ,"-")_U ;N DC . S BPR EC=BPREC_$ $DATTIM^BP SRPT1($P(B PX,U,5))_U   ;Release  Date . S  BPREC=BPRE C_$$MWC^BP SRPT6(BPRX ,BPREF)_U       ;Fill  Location  . S BPREC= BPREC_$$RX STANAM^BPS SCRU2($P(B PX,U,6)) ; Status . S  BPREC=BPR EC_$S($P(B PX,U,5):"/ R",1:"/N") _U    ;RL/ NR . S BPR EC=BPREC_$ $GET1^DIQ( 366.17,$P( BPX,U,7),. 01,"E") ;N on-Billabl e Status R eason - IC R 6136 Q
  1584  
  1585   Modified L ogic (Chan ges are hi ghlighted)
  1586  
  1587    ;Print Re port Line  2 ; ; Inpu t Variable  -> BPRTYP E,BPX,BPRX ,BPREF,BPB IL,BPGRPLA N ; WRLINE 2(BPRTYPE, BPREC,BPX, BPRX,BPREF ,BPBIL,BPG RPLAN,BPPS EQ) ; N BP 59,BP02 S  BP59=$P(BP X,U,3) S B P02=+$P($G (^BPST(BP5 9,0)),U,4)  ; I (BPRT YPE=1)!(BP RTYPE=4) D   Q . ;Dru g, Release d On
  1588    . S BPREC =BPREC_$$D RGNAM^BPSR PT6($P(BPX ,U,14),321 5)_U_$TR($ $GETNDC^BP SRPT6(BPRX ,BPREF),"- ")_U
  1589    . S BPREC =BPREC_$TR ($$GETNDC^ BPSRPT6(BP RX,BPREF), "-")_U ;Re leased On  . S BPREC= BPREC_$$DA TTIM^BPSRP T1(+BPX)_U  . ;RX INF O . S BPRE C=BPREC_$$ MWC^BPSRPT 6(BPRX,BPR EF)_U ;Fil l Location  . S BPREC =BPREC_$$R TBCKNAM^BP SRPT1($$RT BCK^BPSRPT 1($P(BPX,U ,3)))_U ;F ill Type .  S BPREC=B PREC_$$RXS TATUS^BPSR PT6($P(BPX ,U,3)) ;St atus . S B PREC=BPREC _$S($P(BPX ,U):"/R",1 :"/N")_U ; RL/NR . I  BPRTYPE=4  S BPREC=BP REC_$$RXCO B($G(BPPSE Q))_U . S  BPREC=BPRE C_$S($P(BP X,U,13):"R EJ",1:"")  . I BPRTYP E=1 S BPRE C=BPREC_U_ $$BILL^BPS RPT6(BPRX, BPREF,BPPS EQ)_U_$$RX COB($G(BPP SEQ)) ;Bil l # and RX  COB ; I B PRTYPE=2 D   Q . S BP REC=BPREC_ $E($$GRPID ^BPSRPT2(+ $P(BPX,U,3 )),3,10)_U  ;Group ID  . S BPREC =BPREC_$$I NGRCST^BPS SCRLG(BP02 )_U  ;Ingr edient Cos t . S BPRE C=BPREC_$$ DISPFEE^BP SSCRLG(BP0 2)_U  ;Dis pensing Fe e . S BPRE C=BPREC_$T R($J(BPBIL ,10,2)," " )_U ;$Bill ed . S BPR EC=BPREC_$ $QTY^BPSRP T6($P(BPX, U,3))_U ;Q ty . S BPR EC=BPREC_$ $GETNDC^BP SRPT6(BPRX ,BPREF)_U  ;NDC# . S  BPREC=BPRE C_$E($$DRG NAM^BPSRPT 6($P(BPX,U ,14),32),1 ,15)_U ;Dr ug ; I BPR TYPE=3 D   Q . S BPRE C=BPREC_$$ DRGNAM^BPS RPT6($P(BP X,U,14),32 15)_U ;Dru g . S BPRE C=BPREC_$T R($$GETNDC ^BPSRPT6(B PRX,BPREF) ,"-")_U .  ;RX INFO .  S BPREC=B PREC_$$MWC ^BPSRPT6(B PRX,BPREF) _U ;Fill L ocation .  S BPREC=BP REC_$$RTBC KNAM^BPSRP T1($$RTBCK ^BPSRPT1($ P(BPX,U,3) ))_U ;Fill  Type . S  BPREC=BPRE C_$$RXSTAT US^BPSRPT6 ($P(BPX,U, 3)) ;Statu s . S BPRE C=BPREC_$S ($P(BPX,U) :"/R",1:"/ N")_U ;RL/ NR . S BPR EC=BPREC_$ $RXCOB($G( BPPSEQ))_U
  1590    . S BPREC =BPREC_$$E LIGCODE^BP SSCR05($P( BPX,U,3))_ U ;Eligibi lity . S B PREC=BPREC _$S($P(BPX ,U,13):"RE J",1:"") ;  I BPRTYPE =5 D  Q .  S BPREC=BP REC_$$DRGN AM^BPSRPT6 ($P(BPX,U, 14),32)_U  ;Drug . S  BPREC=BPRE C_$TR($$GE TNDC^BPSRP T6(BPRX,BP REF),"-")_ U . ;RX IN FO . S BPR EC=BPREC_$ $MWC^BPSRP T6(BPRX,BP REF)_U ;Fi ll Locatio n . S BPRE C=BPREC_$$ RTBCKNAM^B PSRPT1($$R TBCK^BPSRP T1($P(BPX, U,3)))_U ; Fill Type  . S BPREC= BPREC_$$RX STATUS^BPS RPT6($P(BP X,U,3)) ;S tatus . S  BPREC=BPRE C_$S($P(BP X,U):"/R", 1:"/N")_U  ;RL/NR . S  BPREC=BPR EC_$S($P(B PX,U,13):" REJ",1:"") _U . I $P( BPGRPLAN,U ,2)]"" S B PREC=BPREC _$E($P(BPG RPLAN,U,2) ,1,30) ;In surance .  S BPREC=BP REC_U_$$EL APSE^BPSRP T6($P(BPX, U,3)) ;Ela psed Time  ; I BPRTYP E=7 D  Q .  S BPREC=B PREC_$E($$ CRDHLDID^B PSRPT2(+$P (BPX,U,3)) ,3,23)_U ; Cardholder  ID . S BP REC=BPREC_ $E($$GRPID ^BPSRPT2(+ $P(BPX,U,3 )),3,10)_U   ;Group I D . S BPRE C=BPREC_$T R($J(BPBIL ,10,2)," " )_U ;$Bill ed . S BPR EC=BPREC_$ $DATTIM^BP SRPT1(+$$C LOSEDT^BPS RPT2(+$P(B PX,U,3)))_ U ;Close D t/Time . S  BPREC=BPR EC_$E($$CL SBY^BPSRPT 6(+$P(BPX, U,3)),1,25 )_U ;Close  By . S BP REC=BPREC_ $E($P($$CL RSN^BPSRPT 7(+$P(BPX, U,3)),U,2) ,1,30)_U ; Close Reas on ; I BPR TYPE=8 D   Q . S BPRE C=BPREC_$$ DRGNAM^BPS RPT6($P(BP X,U,14),27 )_U ;Drug  . S BPREC= BPREC_$$MW C^BPSRPT6( BPRX,BPREF )_" " ;Fil l Location  . S BPREC =BPREC_$$R TBCKNAM^BP SRPT1($$RT BCK^BPSRPT 1($P(BPX,U ,3)))_" "  ;Fill Type  . S BPREC =BPREC_$$R XSTATUS^BP SRPT6($P(B PX,U,3)) ; Status . S  BPREC=BPR EC_$S($P(B PX,U):"/R" ,1:"/N")_U  ;RL/NR .  S BPREC=BP REC_$TR($E ($$GRPID^B PSRPT2(+$P (BPX,U,3)) ,3,10)," " ,"")_U  ;G roup ID .  S BPREC=BP REC_$E(BPG RPLAN,1,30 )_U ;Insur ance . S B PREC=BPREC _$$BILL^BP SRPT6(BPRX ,BPREF,BPP SEQ)_U ;Bi ll# ; I BP RTYPE=9 D   Q . S BPR EC=BPREC_$ $DRGNAM^BP SRPT6($P(B PX,U,4),32 15)_U  ;Dr ug . S BPR EC=BPREC_$ TR($$GETND C^BPSRPT6( BPRX,BPREF ),"-")_U ; NDC . S BP REC=BPREC_ $$DATTIM^B PSRPT1($P( BPX,U,5))_ U  ;Releas e Date . S  BPREC=BPR EC_$$MWC^B PSRPT6(BPR X,BPREF)_U       ;Fil l Location  . S BPREC =BPREC_$$R XSTANAM^BP SSCRU2($P( BPX,U,6))  ;Status .  S BPREC=BP REC_$S($P( BPX,U,5):" /R",1:"/N" )_U    ;RL /NR . S BP REC=BPREC_ $$GET1^DIQ (366.17,$P (BPX,U,7), .01,"E") ; Non-Billab le Status  Reason - I CR 6136 Q
  1591  
  1592  
  1593  
  1594   Subroutine  Name
  1595   WRLINE3^BP SRPT8
  1596   Enhancemen t Category
  1597    New
  1598    Modify
  1599    Delete
  1600    No Change
  1601   Current Lo gic
  1602  
  1603    ;Print Re port Line  3 ; ; Inpu t Variable  -> BPRTYP E,BPX ; WR LINE3(BPRT YPE,BPREC, BPX) ; N B P59,BPSARR ,BPRJCNT,B PRJEXP,BPZ Z,BPRICE S  BP59=+$P( BPX,U,3) ;  I (",7,") [BPRTYPE D   Q .S BPR EC=BPREC_$ $CLAIMID^B PSRPT2(BP5 9)_U ;Clai m ID .S BP RJCNT=$$RE JTEXT^BPSR PT2(BP59,. BPSARR) .F  BPZZ=1:1: BPRJCNT S: BPZZ'=1 BP REC=BPREC_ "," S BPRE C=BPREC_$P (BPSARR(BP ZZ),":") . ;Write one  record pe r reject/c lose code  .S:+BPRJCN T=0 BPRJCN T=1 .F BPZ Z=1:1:BPRJ CNT W !,$G (BPREC),U, $P($G(BPSA RR(BPZZ)), ":"),U,$P( $G(BPSARR( BPZZ)),":" ,2) ; I (" ,2,")[BPRT YPE D  Q .  S BPREC=B PREC_$P($$ PRESCIN^BP SRPT6($P(B PX,U,3)),U )_U ;Presc riber ID .  S BPREC=B PREC_$E($P ($$PRESCIN ^BPSRPT6($ P(BPX,U,3) ),U,2),1,1 3)_U ;Pres criber Nam e (truncat ed to 13)  . S BPRJCN T=$$REJTEX T^BPSRPT2( BP59,.BPSA RR) . S BP REC=BPREC_ $S(BPRJCNT >1:"Y",1:" N") . ;Wri te one rec ord per re ject/close  code . S: +BPRJCNT=0  BPRJCNT=1  . F BPZZ= 1:1:BPRJCN T S BPREC2 ="" D . .  S BPREC2=$ G(BPREC)_U _$P($G(BPS ARR(BPZZ)) ,":")_U_$P ($G(BPSARR (BPZZ)),": ",2) W !,$ E(BPREC2,1 ,255) ; I  BPRTYPE=4  D . ;Metho d . I $$AU TOREV^BPSR PT1(BP59)  S BPREC=BP REC_U_"AUT O"_U . E   S BPREC=BP REC_U_"REG ULAR"_U .  ;Return St atus . I $ P(BPX,U,15 )["ACCEPTE D" S BPREC =BPREC_"AC CEPTED"_U  . E  S BPR EC=BPREC_" REJECTED"_ U . ;Reaso n . S BPRE C=BPREC_$$ RVSRSN^BPS RPT7(+$P(B PX,U,3)) ;  I BPRTYPE =8 D . S B PRICE=$$PR ICEVAL^BPS RPT5(BP59)  . S BPREC =BPREC_$P( $G(BPRICE) ,U,3)_U .  S BPREC=BP REC_$P($G( BPRICE),U, 4)_U . S B PREC=BPREC _$P($G(BPR ICE),U,5)_ U . S BPRE C=BPREC_$P ($G(BPRICE ),U,6)_U .  S BPREC=B PREC_$P($G (BPRICE),U ,7)_U . S  BPREC=BPRE C_$P($G(BP RICE),U,2) _U . S BPR EC=BPREC_$ P($G(BPRIC E),U,1)_U  ;Write the  record W  !,$G(BPREC ) Q
  1604  
  1605   Modified L ogic (Chan ges are hi ghlighted)
  1606  
  1607    ;Print Re port Line  3 ; ; Inpu t Variable  -> BPRTYP E,BPX ; WR LINE3(BPRT YPE,BPREC, BPX) ; N B P59,BPSARR ,BPRJCNT,B PRJEXP,BPZ Z,BPRICE S  BP59=+$P( BPX,U,3) ;  I (",7,") [BPRTYPE D   Q . S BP REC=BPREC_ $$CLAIMID^ BPSRPT2(BP 59)_U ;Cla im ID . S  BPRJCNT=$$ REJTEXT^BP SRPT2(BP59 ,.BPSARR)
  1608    . S BPREC =BPREC_$S( BPRJCNT>1: "Y",1:"N")  ;Mult Rej  . ;Write  one record  per rejec t/close co de . S:+BP RJCNT=0 BP RJCNT=1 .  F BPZZ=1:1 :BPRJCNT D  . . S BPR EC2=$G(BPR EC)_U_$P($ G(BPSARR(B PZZ)),":") _U_$P($G(B PSARR(BPZZ )),":",2)  W !,$E(BPR EC2,1,255)  .F BPZZ=1 :1:BPRJCNT  S:BPZZ'=1  BPREC=BPR EC_"," S B PREC=BPREC _$P(BPSARR (BPZZ),":" ) .;Write  one record  per rejec t/close co de .S:+BPR JCNT=0 BPR JCNT=1 .F  BPZZ=1:1:B PRJCNT W ! ,$G(BPREC) ,U,$P($G(B PSARR(BPZZ )),":"),U, $P($G(BPSA RR(BPZZ)), ":",2) ; I  (",2,")[B PRTYPE D   Q . S BPRE C=BPREC_$P ($$PRESCIN ^BPSRPT6($ P(BPX,U,3) ),U)_U ;Pr escriber I D . S BPRE C=BPREC_$E ($P($$PRES CIN^BPSRPT 6($P(BPX,U ,3)),U,2), 1,13)_U ;P rescriber  Name (trun cated to 1 3) . S BPR JCNT=$$REJ TEXT^BPSRP T2(BP59,.B PSARR) . S  BPREC=BPR EC_$S(BPRJ CNT>1:"Y", 1:"N") ;Mu lt Rej . ; Write one  record per  reject/cl ose code .  S:+BPRJCN T=0 BPRJCN T=1 . F BP ZZ=1:1:BPR JCNT S BPR EC2="" D .  . S BPREC 2=$G(BPREC )_U_$P($G( BPSARR(BPZ Z)),":")_U _$P($G(BPS ARR(BPZZ)) ,":",2) W  !,$E(BPREC 2,1,255) ;  I BPRTYPE =4 D . ;Me thod . I $ $AUTOREV^B PSRPT1(BP5 9) S BPREC =BPREC_U_" AUTO"_U .  E  S BPREC =BPREC_U_" REGULAR"_U  . ;Return  Status .  I $P(BPX,U ,15)["ACCE PTED" S BP REC=BPREC_ "ACCEPTED" _U . E  S  BPREC=BPRE C_"REJECTE D"_U . ;Re ason . S B PREC=BPREC _$$RVSRSN^ BPSRPT7(+$ P(BPX,U,3) ) ; I BPRT YPE=8 D .  S BPRICE=$ $PRICEVAL^ BPSRPT5(BP 59) . S BP REC=BPREC_ $P($G(BPRI CE),U,3)_U  . S BPREC =BPREC_$P( $G(BPRICE) ,U,4)_U .  S BPREC=BP REC_$P($G( BPRICE),U, 5)_U . S B PREC=BPREC _$P($G(BPR ICE),U,6)_ U . S BPRE C=BPREC_$P ($G(BPRICE ),U,7)_U .  S BPREC=B PREC_$P($G (BPRICE),U ,2)_U . S  BPREC=BPRE C_$P($G(BP RICE),U,1) _U ;
  1609    ;Write th e record
  1610    I (",1,3, 4,9,")[BPR TYPE W !,$ E(BPREC,1, 255) Q W ! ,$G(BPREC)  Q
  1611  
  1612  
  1613