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

BPSSCRU4.m

Go to the documentation of this file.
  1. BPSSCRU4 ;BHAM ISC/SS - ECME SCREEN UTILITIES ;05-APR-05
  1. ;;1.0;E CLAIMS MGMT ENGINE;**1,3,21**;JUN 2004;Build 28
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;USER SCREEN
  1. Q
  1. ;
  1. ;repeatedly prompts the user for line#
  1. ;the user should "^" to quit or enter a correct line #
  1. ;input:
  1. ; BPROMPT - prompt string
  1. ; BPTYPE expected user's selection on level
  1. ; of P-patient or C-claim or PC - both
  1. ; BPERRMES - optional - the message to display when the user
  1. ; tries to make multi line selection
  1. ; BPDFLT - default value for the prompt (optional)
  1. ;output:
  1. ; piece 1:
  1. ; 1 - okay
  1. ; <0 - errors
  1. ; 0 - user wants to quit
  1. ; piece 2: patient ien #2
  1. ; piece 3: insurance ien #36
  1. ; piece 4: ptr to #9002313.59
  1. ; piece 5: 1st line for index(es) in LM "VALM" array
  1. ; piece 6: patient's index
  1. ; piece 7: claim's index
  1. ASKLINE(BPROMPT,BPTYPE,BPERRMES,BPDFLT) ;
  1. N BPRET,BPCNT
  1. S BPRET="",BPCNT=0
  1. F S BPRET=$$SELLINE(BPROMPT,BPTYPE,VALMAR,$G(BPDFLT)) Q:BPRET'<0 D
  1. . ;D RE^VALM4
  1. . ;
  1. . I BPCNT<1 S BPCNT=BPCNT+1 W !
  1. . E S BPCNT=0 D RE^VALM4
  1. . I BPRET=-1 W " - Invalid line number" ; (invalid Patient summary line)"
  1. . I BPRET=-8 W " - ",$S($G(BPERRMES)]"":BPERRMES,1:" Invalid line number")
  1. . I BPRET=-4 W " - Invalid line number" ; (invalid RX line)"
  1. . I BPRET=-2 W " - Please select Patient's summary line."
  1. . I BPRET=-3 W " - Please specify RX line."
  1. . I BPRET<-4 W " - Incorrect format." ; Corrupted array (",BPRET,")"
  1. Q BPRET
  1. ;/**
  1. ;prompts the user for line# for various menu option of the User Screen
  1. ;input:
  1. ; BPROMPT - prompt string
  1. ; BPTYPE - expected user's selection on level
  1. ; of P-patient or C-claim or PC - both
  1. ; BPTMP1 - temporary global (VALMAR)
  1. ; BPDFLT - default value for the prompt (optional)
  1. ;output:
  1. ; piece 1:
  1. ; 1 - okay
  1. ; <0 - errors
  1. ; 0 - user wants to quit
  1. ; piece 2: patient ien #2
  1. ; piece 3: insurance ien #36
  1. ; piece 4: ptr to #9002313.59
  1. ; piece 5: 1st line for index(es) in LM "VALM" array
  1. ; piece 6: patient's index
  1. ; piece 7: claim's index
  1. SELLINE(BPROMPT,BPTYPE,BPTMP1,BPDFLT) ;*/
  1. N BPX,BPLINE,BPPATIND,BPCLMIND
  1. N BPDFN,BPSINSUR,BP59,BP1LN
  1. ;
  1. ; Attempt to determine default if none passed in
  1. I '$G(BPDFLT) S BPDFLT=$$DEFAULT(BPTYPE,BPTMP1)
  1. ;
  1. S BPLINE=$$PROMPT(BPROMPT,$G(BPDFLT))
  1. I BPLINE="^" Q 0
  1. S BPPATIND=+$P(BPLINE,".")
  1. I (BPLINE["-")!(BPLINE[",") Q -8 ;multiple line input in not allowed
  1. I '$D(@BPTMP1@("LMIND",BPPATIND)) Q -1 ;the patient level doesn't exist
  1. S BPCLMIND=+$P(BPLINE,".",2)
  1. I BPTYPE="P",BPCLMIND>0 Q -2 ;P was requested but claim portion was provided
  1. I BPTYPE="C",BPCLMIND=0 Q -3 ;C was requested but claim portion was not provided
  1. I '$D(@BPTMP1@("LMIND",BPPATIND,BPCLMIND)) Q -4 ;the claim level doesn't exist
  1. S BPDFN=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,0))
  1. I +BPDFN=0 Q -5 ;error
  1. S BPSINSUR=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,""))
  1. I BPSINSUR="" Q -6 ;error
  1. ;if fractional part was entered
  1. I BPCLMIND>0 D I +BP59=0 Q -7 ;error
  1. . S BP59=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,BPSINSUR,0))
  1. I BPCLMIND=0 S BP59=0
  1. S BP1LN=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,BPSINSUR,BP59,0))
  1. I +BP1LN=0 Q -7 ;error
  1. Q "1"_U_BPDFN_U_BPSINSUR_U_BP59_U_BP1LN_U_BPPATIND_U_BPCLMIND
  1. ;
  1. ;input:
  1. ;BPSPROM - prompt text
  1. ;BPSDFVL - default value (optional)
  1. ;returns:
  1. ; "response^"
  1. PROMPT(BPSPROM,BPSDFVL) ;
  1. N BPRET,DIR,X,Y,DIRUT
  1. S BPRET="^"
  1. S DIR(0)="F^::2",DIR("A")=BPSPROM
  1. I $L($G(BPSDFVL))>0 S DIR("B")=$G(BPSDFVL)
  1. D ^DIR I $D(DIRUT) Q "^"
  1. S $P(BPRET,U)=Y
  1. Q BPRET
  1. ;
  1. ;/**
  1. ;check and process user input
  1. ;input:
  1. ; BPLINE - input string
  1. ; BPTYPE - expected user's selection on level
  1. ; of P-patient or C-claim or PC - both
  1. ; BPTMP1 - temporary global (VALMAR)
  1. ;output:
  1. ; piece 1:
  1. ; 1 - okay
  1. ; <0 - errors
  1. ; 0 - user wants to quit
  1. ; piece 2: patient ien #2
  1. ; piece 3: insurance ien #36
  1. ; piece 4: ptr to #9002313.59
  1. ; piece 5: 1st line for index(es) in LM "VALM" array
  1. ; piece 6: patient's index
  1. ; piece 7: claim's index
  1. CHECKLN(BPLINE,BPTYPE,BPTMP1) ;*/
  1. N BPX,BPPATIND,BPCLMIND
  1. N BPDFN,BPSINSUR,BP59,BP1LN
  1. I BPLINE="^" Q 0
  1. S BPPATIND=+$P(BPLINE,".")
  1. I '$D(@BPTMP1@("LMIND",BPPATIND)) Q -1 ;the patient level doesn't exist
  1. S BPCLMIND=+$P(BPLINE,".",2)
  1. I BPTYPE="P",BPCLMIND>0 Q -2 ;P was requested but claim portion was provided
  1. I BPTYPE="C",BPCLMIND=0 Q -3 ;C was requested but claim portion was not provided
  1. I '$D(@BPTMP1@("LMIND",BPPATIND,BPCLMIND)) Q -4 ;the claim level doesn't exist
  1. S BPDFN=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,0))
  1. I +BPDFN=0 Q -5 ;error
  1. S BPSINSUR=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,""))
  1. I BPSINSUR="" Q -6 ;error
  1. ;if fractional part was entered
  1. I BPCLMIND>0 D I +BP59=0 Q -7 ;error
  1. . S BP59=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,BPSINSUR,0))
  1. I BPCLMIND=0 S BP59=0
  1. S BP1LN=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,BPSINSUR,BP59,0))
  1. I +BP1LN=0 Q -7 ;error
  1. Q "1"_U_BPDFN_U_BPSINSUR_U_BP59_U_BP1LN_U_BPPATIND_U_BPCLMIND
  1. ;
  1. ;
  1. ;BPTMP = VALMAR
  1. ;input:
  1. ; BPROMPT - prompt text
  1. ; BPTYPE - expected user's selection on level
  1. ; of P-patient or C-claim or PC - both
  1. ; BPTMP - temporary global (like VALMAR)
  1. ; BPARRLN2 - to return results
  1. ;output :
  1. ; 1 if okay
  1. ; -1 -invalid format
  1. ; ^ - quit
  1. ; BPARRLN2 - Array(B59)="line# in VALM"^"PatientIndex.ClaimIndex"
  1. ;example:
  1. ; BPARR(30045.00001)=134^2.34
  1. ASKLINES(BPROMPT,BPTYPE,BPARRLN2,BPTMP) ;
  1. N BPQ,BPXLN,BPN,BPLN,BPZ
  1. N BPL,BPCLM,BPDFLT
  1. N BPARRLN1,BPX1
  1. ;
  1. ; Attempt to determine default
  1. S BPDFLT=$$DEFAULT(BPTYPE,BPTMP)
  1. ;
  1. S BPSPROM="Select item(s)"
  1. S BPLN=$$PROMPT(BPSPROM,BPDFLT)
  1. I BPLN="^" Q "^"
  1. S BPLN=$P(BPLN,U)
  1. S BPQ=0
  1. F BPN=1:1 S BPX1=$P(BPLN,",",BPN) Q:$L(BPX1)=0 D Q:BPQ'=0
  1. . S BPZ=$$MKINDEXS(BPX1,BPTMP,.BPARRLN1)
  1. . I BPZ<1 S BPQ=-1
  1. . I (BPZ=-1)!(BPZ=-2) W !,"Invalid format.",!
  1. . I (BPZ=-3) W !,"Not a valid selection.",!
  1. Q:BPQ=-1 -1
  1. ;
  1. N BPPAT,BPCLM
  1. S BPPAT=0 F S BPPAT=$O(BPARRLN1(BPPAT)) Q:BPPAT="" D
  1. . S BPCLM=0 F S BPCLM=$O(BPARRLN1(BPPAT,BPCLM)) Q:BPCLM="" D
  1. . . S BP1=$G(BPARRLN1(BPPAT,BPCLM))
  1. . . Q:$L(BP1)=0
  1. . . S BPARRLN2(+$P(BP1,U,4))=+$P(BP1,U,5)_U_BPPAT_"."_BPCLM
  1. Q 1
  1. ;
  1. ;/**
  1. ;checks for dashes and if so then create a number of indexes for the range
  1. ;i.e. convert all "1.2-2.3" to "1.2,1.3,1.4,2.1,2.2,2.3"
  1. ;AND create entries in BPARR for all "right" indexes
  1. ;input:
  1. ;BPVAL - value to check (exmpl: "1.2-2.4")
  1. ;BPTMP1 - global ref with data (exmpl: VALMAR)
  1. ;BPARR - array with parsed line indexes
  1. ;output:
  1. ;Exmpl:
  1. ; BPARR(1.2)=""
  1. ; BPARR(1.3)=""
  1. ; ...
  1. ; returns:
  1. ; 1 - okay
  1. ; <0 invalid format
  1. MKINDEXS(BPVAL,BPTMP1,BPARR) ;
  1. N BPFR,BPTO,BPQ,BPRET
  1. N BPPAT,BPCLM,BPCLSTRT,BPCLEND,BPQ2
  1. N BPFRPAT,BPTOPAT,BPFRCLM,BPTOCLM,BP1
  1. S BPQ=0
  1. S BPRET=1
  1. I BPVAL'["-" D Q BPRET
  1. . S BPPAT=$P(BPVAL,".",1)
  1. . I BPPAT'=+BPPAT S BPRET=-1 Q ;invalid format, patient part is not numeric
  1. . S BPCLM=$P(BPVAL,".",2)
  1. . ;if only patient index
  1. . I $L(BPCLM)=0 D Q
  1. . . S BPQ2=0
  1. . . F BPCLM=1:1 D Q:BPQ2'=0
  1. . . . ;quit if there are no more claims for the patient
  1. . . . S BP1=$$CHECKLN(BPPAT_"."_BPCLM,"C",BPTMP1)
  1. . . . I BP1<1 S BPQ2=1 Q
  1. . . . S BPARR(+BPPAT,+BPCLM)=BP1
  1. . ;if only patient+claim index
  1. . I BPCLM'=+BPCLM S BPRET=-2 Q ;invalid format, claim portion is not numeric
  1. . S BP1=$$CHECKLN(BPPAT_"."_BPCLM,"C",BPTMP1)
  1. . I BP1<1 S BPRET=-3 Q ;not found
  1. . S BPARR(+BPPAT,+BPCLM)=BP1
  1. ;********* if contains "-"
  1. S BPFR=$P(BPVAL,"-",1)
  1. S BPTO=$P(BPVAL,"-",2)
  1. I BPTO["-" Q -3 ;invalid format (to many dashes)
  1. S BPFRPAT=$P(BPFR,".",1)
  1. S BPTOPAT=$P(BPTO,".",1)
  1. S BPFRCLM=$P(BPFR,".",2)
  1. I $L(BPFRCLM)=0 S BPFRCLM=1
  1. S BPTOCLM=$P(BPTO,".",2)
  1. I $L(BPTOCLM)=0 S BPTOCLM=999999
  1. I BPFRPAT'=+BPFRPAT Q -1 ;invalid format, patient part is not numeric
  1. I BPTOPAT'=+BPTOPAT Q -1 ;invalid format, patient part is not numeric
  1. I BPFRCLM'=+BPFRCLM Q -2 ;invalid format, claim portion is not numeric
  1. I BPTOCLM'=+BPTOCLM Q -2 ;invalid format, claim portion is not numeric
  1. F BPPAT=BPFRPAT:1:BPTOPAT D
  1. . I BPPAT=BPFRPAT S BPCLSTRT=BPFRCLM
  1. . E S BPCLSTRT=1
  1. . I BPPAT=BPTOPAT S BPCLEND=BPTOCLM
  1. . E S BPCLEND=999999
  1. . S BPQ2=0
  1. . F BPCLM=BPCLSTRT:1:BPCLEND D Q:BPQ2'=0
  1. . . ;quit if there are no more claims for the patient
  1. . . S BP1=$$CHECKLN(BPPAT_"."_BPCLM,"C",BPTMP1)
  1. . . I BP1<1 S BPQ2=1 Q
  1. . . S BPARR(+BPPAT,+BPCLM)=BP1
  1. Q 1
  1. ;
  1. ; DEFAULT will return a value to be used as the default at the
  1. ; Select Item prompt if there is only one item on the list. If the
  1. ; user must enter a patient-level item (BPTYPE of "P"), the the
  1. ; patient number will be returned if only one. Otherwise the claim
  1. ; number will be returned if only one patient and one claim.
  1. ; Input: BPTYPE - P if user should enter a Patient
  1. ; C if user should enter a Claim
  1. ; PC if user may enter either
  1. ; BPLIST - temporary global (VALMAR)
  1. ; Output: $$DEFAULT - Either a patient number, or a claim number,
  1. ; or <blank> if neither could be defaulted
  1. DEFAULT(BPTYPE,BPLIST) ; Determine default item number - BPS*1.0*21
  1. N BPSCLAIM,BPSPATIENT
  1. S BPSPATIENT=$O(@BPLIST@("LMIND",0))
  1. I $O(@BPLIST@("LMIND",BPSPATIENT))'="" Q "" ; if not one patient, Quit ""
  1. I BPTYPE="P" Q BPSPATIENT ; if BPTYPE is P(atient), then Quit with the patient
  1. S BPSCLAIM=$O(@BPLIST@("LMIND",BPSPATIENT,0))
  1. I $O(@BPLIST@("LMIND",BPSPATIENT,BPSCLAIM))'="" Q "" ; if not one claim, Quit ""
  1. Q BPSPATIENT_"."_BPSCLAIM
  1. ;