Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BPSPRRX1

BPSPRRX1.m

Go to the documentation of this file.
  1. BPSPRRX1 ;ALB/SS - ePharmacy secondary billing ;16-DEC-08
  1. ;;1.0;E CLAIMS MGMT ENGINE;**8,9**;JUN 2004;Build 18
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ;
  1. ;display available plans and prompt the user to select the plan
  1. ;input:
  1. ; BPSDFN - patient's DFN
  1. ; BPSDOS - date of service
  1. ; BPRETAR - array to return details for the selected plan (by reference)
  1. ; BPSPRMT - prompt
  1. ; BPDEFPLN (optional) - default plan
  1. ;return: 0 if not selected
  1. ; "-110^No valid group insurance plans" if no plans
  1. ;return: the GROUP INSURANCE PLAN ien (#355.3)
  1. ; and selected plan's details in BPRETAR
  1. SELECTPL(BPSDFN,BPSDOS,BPRETAR,BPSPRMT,BPDEFPLN) ;
  1. N BPSRET,BPSARR
  1. S BPSRET=$$SELPLAN(BPSDFN,BPSDOS,"E",.BPSARR,"1,7,8,10,11,14,12,18",1,$S($L($G(BPSPRMT)):BPSPRMT,1:"SECONDARY INSURANCE POLICY"),"",$G(BPDEFPLN))
  1. Q:+BPSRET=-1 0
  1. Q:+BPSRET=-110 BPSRET
  1. Q:+BPSRET=0 0
  1. M BPRETAR=BPSARR("IBBAPI","INSUR",+$P(BPSRET,U,3))
  1. Q +$P(BPRETAR(8),U,1)
  1. ;
  1. ;select insurance from the list of the insurances which was built for the current user setting
  1. ;for the User Screen.
  1. ;input :
  1. ; BPSDFN - patient's DFN
  1. ; BPSDOS - date of service
  1. ; BPSTAT - IBSTAT flag in INSUR^IBBAPI
  1. ; BPSARR - array to return results (by reference)
  1. ; BPSFLDS - IBFLDS in INSUR^IBBAPI (list of fields to return, "*" for all)
  1. ; BPSDISPL - display insurances before prompting for selection
  1. ; BPSMESS - message to display before prompt
  1. ; BPDEFPLN (optional) - default plan
  1. ;output : 1^name of the insurance or null
  1. ;0^ - if "^" or was not selected
  1. SELPLAN(BPSDFN,BPSDOS,BPSTAT,BPSARR,BPSFLDS,BPSDISPL,BPSPRMPT,BPSMESS,BPDEFPLN) ;
  1. N BPSRET,BPSDFLT,BPSVAL
  1. N DIR,Y,X
  1. N BPX,BPCNT,BPTEL,BPCNT2
  1. S BPSDFLT=""
  1. S BPSRET=$$INSUR^IBBAPI(BPSDFN,BPSDOS,BPSTAT,.BPSARR,BPSFLDS)
  1. Q:'BPSRET "-110^No valid group insurance plans"
  1. W !,?4,"Insurance",?18,"COB",?23,"Subscriber ID",?37,"Group",?48,"Holder",?57,"Effective",?68,"Expires"
  1. W !,?4,"=============",?18,"====",?23,"=============",?37,"==========",?48,"========",?57,"==========",?68,"=========="
  1. S BPX=0
  1. I $G(BPSDISPL) F S BPX=$O(BPSARR("IBBAPI","INSUR",BPX)) Q:BPX="" D
  1. . W !,?1,BPX
  1. . W ?4,$E($P($G(BPSARR("IBBAPI","INSUR",BPX,1)),U,2),1,13)
  1. . W ?18,$E($P($G(BPSARR("IBBAPI","INSUR",BPX,7)),U,2),1,3)
  1. . W ?23,$E($P($G(BPSARR("IBBAPI","INSUR",BPX,14)),U,1),1,13)
  1. . W ?37,$E($P($G(BPSARR("IBBAPI","INSUR",BPX,8)),U,2),1,10)
  1. . W ?48,$E($P($G(BPSARR("IBBAPI","INSUR",BPX,12)),U,2),1,9)
  1. . W:+$G(BPSARR("IBBAPI","INSUR",BPX,10)) ?57,$$FMTE^XLFDT(+$G(BPSARR("IBBAPI","INSUR",BPX,10)),"5Z")
  1. . W:+$G(BPSARR("IBBAPI","INSUR",BPX,11)) ?68,$$FMTE^XLFDT(+$G(BPSARR("IBBAPI","INSUR",BPX,11)),"5Z")
  1. W !!
  1. S BPX=0,BPCNT=0
  1. S DIR("A")=BPSPRMPT
  1. I $L($G(BPSMESS))>0 D
  1. . S DIR("A","?")=BPSMESS
  1. . S DIR("A",1)=""
  1. . S DIR("A",2)=BPSMESS
  1. . S DIR("A",3)=""
  1. K ^TMP($J,"BPSPRRX1","LOOKUP")
  1. F S BPX=$O(BPSARR("IBBAPI","INSUR",BPX)) Q:BPX="" D
  1. . S BPCNT=BPCNT+1
  1. . S BPSVAL=$E($P($G(BPSARR("IBBAPI","INSUR",BPX,1)),U,2)_" ("_$P($G(BPSARR("IBBAPI","INSUR",BPX,7)),U,2)_") - "_$P($G(BPSARR("IBBAPI","INSUR",BPX,8)),U,2),1,60)
  1. . S ^TMP($J,"BPSPRRX1","LOOKUP",BPCNT,0)=BPSVAL_U_BPX
  1. . S ^TMP($J,"BPSPRRX1","LOOKUP","B",BPX,BPCNT)=""
  1. . I $G(BPDEFPLN)>0 I +BPSARR("IBBAPI","INSUR",BPX,8)=BPDEFPLN S BPSDFLT=BPX
  1. I BPCNT=0 Q "0^"
  1. S ^TMP($J,"BPSPRRX1","LOOKUP",0)=U_U_BPCNT_U_BPCNT
  1. ;set DIR variables
  1. S DIR(0)="P^TMP($J,""BPSPRRX1"",""LOOKUP"",:AEQMZ"
  1. I BPSDFLT'="" S DIR("B")=BPSDFLT ;$E(BPSDFLT,1,14)
  1. D ^DIR
  1. S BPX=$P($G(^TMP($J,"BPSPRRX1","LOOKUP",+Y,0)),U,2)
  1. K ^TMP($J,"BPSPRRX1","LOOKUP")
  1. I X="^" Q "-1^"
  1. I $TR($P(Y,U,2)," ")="" Q "0^"
  1. Q Y_U_BPX
  1. ;