BPSSCRU4 ;BHAM ISC/SS - ECME SCREEN UTILITIES ;05-APR-05
;;1.0;E CLAIMS MGMT ENGINE;**1,3,21**;JUN 2004;Build 28
;;Per VA Directive 6402, this routine should not be modified.
;USER SCREEN
Q
;
;repeatedly prompts the user for line#
;the user should "^" to quit or enter a correct line #
;input:
; BPROMPT - prompt string
; BPTYPE expected user's selection on level
; of P-patient or C-claim or PC - both
; BPERRMES - optional - the message to display when the user
; tries to make multi line selection
; BPDFLT - default value for the prompt (optional)
;output:
; piece 1:
; 1 - okay
; <0 - errors
; 0 - user wants to quit
; piece 2: patient ien #2
; piece 3: insurance ien #36
; piece 4: ptr to #9002313.59
; piece 5: 1st line for index(es) in LM "VALM" array
; piece 6: patient's index
; piece 7: claim's index
ASKLINE(BPROMPT,BPTYPE,BPERRMES,BPDFLT) ;
N BPRET,BPCNT
S BPRET="",BPCNT=0
F S BPRET=$$SELLINE(BPROMPT,BPTYPE,VALMAR,$G(BPDFLT)) Q:BPRET'<0 D
. ;D RE^VALM4
. ;
. I BPCNT<1 S BPCNT=BPCNT+1 W !
. E S BPCNT=0 D RE^VALM4
. I BPRET=-1 W " - Invalid line number" ; (invalid Patient summary line)"
. I BPRET=-8 W " - ",$S($G(BPERRMES)]"":BPERRMES,1:" Invalid line number")
. I BPRET=-4 W " - Invalid line number" ; (invalid RX line)"
. I BPRET=-2 W " - Please select Patient's summary line."
. I BPRET=-3 W " - Please specify RX line."
. I BPRET<-4 W " - Incorrect format." ; Corrupted array (",BPRET,")"
Q BPRET
;/**
;prompts the user for line# for various menu option of the User Screen
;input:
; BPROMPT - prompt string
; BPTYPE - expected user's selection on level
; of P-patient or C-claim or PC - both
; BPTMP1 - temporary global (VALMAR)
; BPDFLT - default value for the prompt (optional)
;output:
; piece 1:
; 1 - okay
; <0 - errors
; 0 - user wants to quit
; piece 2: patient ien #2
; piece 3: insurance ien #36
; piece 4: ptr to #9002313.59
; piece 5: 1st line for index(es) in LM "VALM" array
; piece 6: patient's index
; piece 7: claim's index
SELLINE(BPROMPT,BPTYPE,BPTMP1,BPDFLT) ;*/
N BPX,BPLINE,BPPATIND,BPCLMIND
N BPDFN,BPSINSUR,BP59,BP1LN
;
; Attempt to determine default if none passed in
I '$G(BPDFLT) S BPDFLT=$$DEFAULT(BPTYPE,BPTMP1)
;
S BPLINE=$$PROMPT(BPROMPT,$G(BPDFLT))
I BPLINE="^" Q 0
S BPPATIND=+$P(BPLINE,".")
I (BPLINE["-")!(BPLINE[",") Q -8 ;multiple line input in not allowed
I '$D(@BPTMP1@("LMIND",BPPATIND)) Q -1 ;the patient level doesn't exist
S BPCLMIND=+$P(BPLINE,".",2)
I BPTYPE="P",BPCLMIND>0 Q -2 ;P was requested but claim portion was provided
I BPTYPE="C",BPCLMIND=0 Q -3 ;C was requested but claim portion was not provided
I '$D(@BPTMP1@("LMIND",BPPATIND,BPCLMIND)) Q -4 ;the claim level doesn't exist
S BPDFN=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,0))
I +BPDFN=0 Q -5 ;error
S BPSINSUR=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,""))
I BPSINSUR="" Q -6 ;error
;if fractional part was entered
I BPCLMIND>0 D I +BP59=0 Q -7 ;error
. S BP59=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,BPSINSUR,0))
I BPCLMIND=0 S BP59=0
S BP1LN=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,BPSINSUR,BP59,0))
I +BP1LN=0 Q -7 ;error
Q "1"_U_BPDFN_U_BPSINSUR_U_BP59_U_BP1LN_U_BPPATIND_U_BPCLMIND
;
;input:
;BPSPROM - prompt text
;BPSDFVL - default value (optional)
;returns:
; "response^"
PROMPT(BPSPROM,BPSDFVL) ;
N BPRET,DIR,X,Y,DIRUT
S BPRET="^"
S DIR(0)="F^::2",DIR("A")=BPSPROM
I $L($G(BPSDFVL))>0 S DIR("B")=$G(BPSDFVL)
D ^DIR I $D(DIRUT) Q "^"
S $P(BPRET,U)=Y
Q BPRET
;
;/**
;check and process user input
;input:
; BPLINE - input string
; BPTYPE - expected user's selection on level
; of P-patient or C-claim or PC - both
; BPTMP1 - temporary global (VALMAR)
;output:
; piece 1:
; 1 - okay
; <0 - errors
; 0 - user wants to quit
; piece 2: patient ien #2
; piece 3: insurance ien #36
; piece 4: ptr to #9002313.59
; piece 5: 1st line for index(es) in LM "VALM" array
; piece 6: patient's index
; piece 7: claim's index
CHECKLN(BPLINE,BPTYPE,BPTMP1) ;*/
N BPX,BPPATIND,BPCLMIND
N BPDFN,BPSINSUR,BP59,BP1LN
I BPLINE="^" Q 0
S BPPATIND=+$P(BPLINE,".")
I '$D(@BPTMP1@("LMIND",BPPATIND)) Q -1 ;the patient level doesn't exist
S BPCLMIND=+$P(BPLINE,".",2)
I BPTYPE="P",BPCLMIND>0 Q -2 ;P was requested but claim portion was provided
I BPTYPE="C",BPCLMIND=0 Q -3 ;C was requested but claim portion was not provided
I '$D(@BPTMP1@("LMIND",BPPATIND,BPCLMIND)) Q -4 ;the claim level doesn't exist
S BPDFN=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,0))
I +BPDFN=0 Q -5 ;error
S BPSINSUR=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,""))
I BPSINSUR="" Q -6 ;error
;if fractional part was entered
I BPCLMIND>0 D I +BP59=0 Q -7 ;error
. S BP59=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,BPSINSUR,0))
I BPCLMIND=0 S BP59=0
S BP1LN=$O(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,BPSINSUR,BP59,0))
I +BP1LN=0 Q -7 ;error
Q "1"_U_BPDFN_U_BPSINSUR_U_BP59_U_BP1LN_U_BPPATIND_U_BPCLMIND
;
;
;BPTMP = VALMAR
;input:
; BPROMPT - prompt text
; BPTYPE - expected user's selection on level
; of P-patient or C-claim or PC - both
; BPTMP - temporary global (like VALMAR)
; BPARRLN2 - to return results
;output :
; 1 if okay
; -1 -invalid format
; ^ - quit
; BPARRLN2 - Array(B59)="line# in VALM"^"PatientIndex.ClaimIndex"
;example:
; BPARR(30045.00001)=134^2.34
ASKLINES(BPROMPT,BPTYPE,BPARRLN2,BPTMP) ;
N BPQ,BPXLN,BPN,BPLN,BPZ
N BPL,BPCLM,BPDFLT
N BPARRLN1,BPX1
;
; Attempt to determine default
S BPDFLT=$$DEFAULT(BPTYPE,BPTMP)
;
S BPSPROM="Select item(s)"
S BPLN=$$PROMPT(BPSPROM,BPDFLT)
I BPLN="^" Q "^"
S BPLN=$P(BPLN,U)
S BPQ=0
F BPN=1:1 S BPX1=$P(BPLN,",",BPN) Q:$L(BPX1)=0 D Q:BPQ'=0
. S BPZ=$$MKINDEXS(BPX1,BPTMP,.BPARRLN1)
. I BPZ<1 S BPQ=-1
. I (BPZ=-1)!(BPZ=-2) W !,"Invalid format.",!
. I (BPZ=-3) W !,"Not a valid selection.",!
Q:BPQ=-1 -1
;
N BPPAT,BPCLM
S BPPAT=0 F S BPPAT=$O(BPARRLN1(BPPAT)) Q:BPPAT="" D
. S BPCLM=0 F S BPCLM=$O(BPARRLN1(BPPAT,BPCLM)) Q:BPCLM="" D
. . S BP1=$G(BPARRLN1(BPPAT,BPCLM))
. . Q:$L(BP1)=0
. . S BPARRLN2(+$P(BP1,U,4))=+$P(BP1,U,5)_U_BPPAT_"."_BPCLM
Q 1
;
;/**
;checks for dashes and if so then create a number of indexes for the range
;i.e. convert all "1.2-2.3" to "1.2,1.3,1.4,2.1,2.2,2.3"
;AND create entries in BPARR for all "right" indexes
;input:
;BPVAL - value to check (exmpl: "1.2-2.4")
;BPTMP1 - global ref with data (exmpl: VALMAR)
;BPARR - array with parsed line indexes
;output:
;Exmpl:
; BPARR(1.2)=""
; BPARR(1.3)=""
; ...
; returns:
; 1 - okay
; <0 invalid format
MKINDEXS(BPVAL,BPTMP1,BPARR) ;
N BPFR,BPTO,BPQ,BPRET
N BPPAT,BPCLM,BPCLSTRT,BPCLEND,BPQ2
N BPFRPAT,BPTOPAT,BPFRCLM,BPTOCLM,BP1
S BPQ=0
S BPRET=1
I BPVAL'["-" D Q BPRET
. S BPPAT=$P(BPVAL,".",1)
. I BPPAT'=+BPPAT S BPRET=-1 Q ;invalid format, patient part is not numeric
. S BPCLM=$P(BPVAL,".",2)
. ;if only patient index
. I $L(BPCLM)=0 D Q
. . S BPQ2=0
. . F BPCLM=1:1 D Q:BPQ2'=0
. . . ;quit if there are no more claims for the patient
. . . S BP1=$$CHECKLN(BPPAT_"."_BPCLM,"C",BPTMP1)
. . . I BP1<1 S BPQ2=1 Q
. . . S BPARR(+BPPAT,+BPCLM)=BP1
. ;if only patient+claim index
. I BPCLM'=+BPCLM S BPRET=-2 Q ;invalid format, claim portion is not numeric
. S BP1=$$CHECKLN(BPPAT_"."_BPCLM,"C",BPTMP1)
. I BP1<1 S BPRET=-3 Q ;not found
. S BPARR(+BPPAT,+BPCLM)=BP1
;********* if contains "-"
S BPFR=$P(BPVAL,"-",1)
S BPTO=$P(BPVAL,"-",2)
I BPTO["-" Q -3 ;invalid format (to many dashes)
S BPFRPAT=$P(BPFR,".",1)
S BPTOPAT=$P(BPTO,".",1)
S BPFRCLM=$P(BPFR,".",2)
I $L(BPFRCLM)=0 S BPFRCLM=1
S BPTOCLM=$P(BPTO,".",2)
I $L(BPTOCLM)=0 S BPTOCLM=999999
I BPFRPAT'=+BPFRPAT Q -1 ;invalid format, patient part is not numeric
I BPTOPAT'=+BPTOPAT Q -1 ;invalid format, patient part is not numeric
I BPFRCLM'=+BPFRCLM Q -2 ;invalid format, claim portion is not numeric
I BPTOCLM'=+BPTOCLM Q -2 ;invalid format, claim portion is not numeric
F BPPAT=BPFRPAT:1:BPTOPAT D
. I BPPAT=BPFRPAT S BPCLSTRT=BPFRCLM
. E S BPCLSTRT=1
. I BPPAT=BPTOPAT S BPCLEND=BPTOCLM
. E S BPCLEND=999999
. S BPQ2=0
. F BPCLM=BPCLSTRT:1:BPCLEND D Q:BPQ2'=0
. . ;quit if there are no more claims for the patient
. . S BP1=$$CHECKLN(BPPAT_"."_BPCLM,"C",BPTMP1)
. . I BP1<1 S BPQ2=1 Q
. . S BPARR(+BPPAT,+BPCLM)=BP1
Q 1
;
; DEFAULT will return a value to be used as the default at the
; Select Item prompt if there is only one item on the list. If the
; user must enter a patient-level item (BPTYPE of "P"), the the
; patient number will be returned if only one. Otherwise the claim
; number will be returned if only one patient and one claim.
; Input: BPTYPE - P if user should enter a Patient
; C if user should enter a Claim
; PC if user may enter either
; BPLIST - temporary global (VALMAR)
; Output: $$DEFAULT - Either a patient number, or a claim number,
; or <blank> if neither could be defaulted
DEFAULT(BPTYPE,BPLIST) ; Determine default item number - BPS*1.0*21
N BPSCLAIM,BPSPATIENT
S BPSPATIENT=$O(@BPLIST@("LMIND",0))
I $O(@BPLIST@("LMIND",BPSPATIENT))'="" Q "" ; if not one patient, Quit ""
I BPTYPE="P" Q BPSPATIENT ; if BPTYPE is P(atient), then Quit with the patient
S BPSCLAIM=$O(@BPLIST@("LMIND",BPSPATIENT,0))
I $O(@BPLIST@("LMIND",BPSPATIENT,BPSCLAIM))'="" Q "" ; if not one claim, Quit ""
Q BPSPATIENT_"."_BPSCLAIM
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSSCRU4 9735 printed Oct 16, 2024@17:54:10 Page 2
BPSSCRU4 ;BHAM ISC/SS - ECME SCREEN UTILITIES ;05-APR-05
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,3,21**;JUN 2004;Build 28
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;USER SCREEN
+4 QUIT
+5 ;
+6 ;repeatedly prompts the user for line#
+7 ;the user should "^" to quit or enter a correct line #
+8 ;input:
+9 ; BPROMPT - prompt string
+10 ; BPTYPE expected user's selection on level
+11 ; of P-patient or C-claim or PC - both
+12 ; BPERRMES - optional - the message to display when the user
+13 ; tries to make multi line selection
+14 ; BPDFLT - default value for the prompt (optional)
+15 ;output:
+16 ; piece 1:
+17 ; 1 - okay
+18 ; <0 - errors
+19 ; 0 - user wants to quit
+20 ; piece 2: patient ien #2
+21 ; piece 3: insurance ien #36
+22 ; piece 4: ptr to #9002313.59
+23 ; piece 5: 1st line for index(es) in LM "VALM" array
+24 ; piece 6: patient's index
+25 ; piece 7: claim's index
ASKLINE(BPROMPT,BPTYPE,BPERRMES,BPDFLT) ;
+1 NEW BPRET,BPCNT
+2 SET BPRET=""
SET BPCNT=0
+3 FOR
SET BPRET=$$SELLINE(BPROMPT,BPTYPE,VALMAR,$GET(BPDFLT))
if BPRET'<0
QUIT
Begin DoDot:1
+4 ;D RE^VALM4
+5 ;
+6 IF BPCNT<1
SET BPCNT=BPCNT+1
WRITE !
+7 IF '$TEST
SET BPCNT=0
DO RE^VALM4
+8 ; (invalid Patient summary line)"
IF BPRET=-1
WRITE " - Invalid line number"
+9 IF BPRET=-8
WRITE " - ",$SELECT($GET(BPERRMES)]"":BPERRMES,1:" Invalid line number")
+10 ; (invalid RX line)"
IF BPRET=-4
WRITE " - Invalid line number"
+11 IF BPRET=-2
WRITE " - Please select Patient's summary line."
+12 IF BPRET=-3
WRITE " - Please specify RX line."
+13 ; Corrupted array (",BPRET,")"
IF BPRET<-4
WRITE " - Incorrect format."
End DoDot:1
+14 QUIT BPRET
+15 ;/**
+16 ;prompts the user for line# for various menu option of the User Screen
+17 ;input:
+18 ; BPROMPT - prompt string
+19 ; BPTYPE - expected user's selection on level
+20 ; of P-patient or C-claim or PC - both
+21 ; BPTMP1 - temporary global (VALMAR)
+22 ; BPDFLT - default value for the prompt (optional)
+23 ;output:
+24 ; piece 1:
+25 ; 1 - okay
+26 ; <0 - errors
+27 ; 0 - user wants to quit
+28 ; piece 2: patient ien #2
+29 ; piece 3: insurance ien #36
+30 ; piece 4: ptr to #9002313.59
+31 ; piece 5: 1st line for index(es) in LM "VALM" array
+32 ; piece 6: patient's index
+33 ; piece 7: claim's index
SELLINE(BPROMPT,BPTYPE,BPTMP1,BPDFLT) ;*/
+1 NEW BPX,BPLINE,BPPATIND,BPCLMIND
+2 NEW BPDFN,BPSINSUR,BP59,BP1LN
+3 ;
+4 ; Attempt to determine default if none passed in
+5 IF '$GET(BPDFLT)
SET BPDFLT=$$DEFAULT(BPTYPE,BPTMP1)
+6 ;
+7 SET BPLINE=$$PROMPT(BPROMPT,$GET(BPDFLT))
+8 IF BPLINE="^"
QUIT 0
+9 SET BPPATIND=+$PIECE(BPLINE,".")
+10 ;multiple line input in not allowed
IF (BPLINE["-")!(BPLINE[",")
QUIT -8
+11 ;the patient level doesn't exist
IF '$DATA(@BPTMP1@("LMIND",BPPATIND))
QUIT -1
+12 SET BPCLMIND=+$PIECE(BPLINE,".",2)
+13 ;P was requested but claim portion was provided
IF BPTYPE="P"
IF BPCLMIND>0
QUIT -2
+14 ;C was requested but claim portion was not provided
IF BPTYPE="C"
IF BPCLMIND=0
QUIT -3
+15 ;the claim level doesn't exist
IF '$DATA(@BPTMP1@("LMIND",BPPATIND,BPCLMIND))
QUIT -4
+16 SET BPDFN=$ORDER(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,0))
+17 ;error
IF +BPDFN=0
QUIT -5
+18 SET BPSINSUR=$ORDER(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,""))
+19 ;error
IF BPSINSUR=""
QUIT -6
+20 ;if fractional part was entered
+21 ;error
IF BPCLMIND>0
Begin DoDot:1
+22 SET BP59=$ORDER(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,BPSINSUR,0))
End DoDot:1
IF +BP59=0
QUIT -7
+23 IF BPCLMIND=0
SET BP59=0
+24 SET BP1LN=$ORDER(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,BPSINSUR,BP59,0))
+25 ;error
IF +BP1LN=0
QUIT -7
+26 QUIT "1"_U_BPDFN_U_BPSINSUR_U_BP59_U_BP1LN_U_BPPATIND_U_BPCLMIND
+27 ;
+28 ;input:
+29 ;BPSPROM - prompt text
+30 ;BPSDFVL - default value (optional)
+31 ;returns:
+32 ; "response^"
PROMPT(BPSPROM,BPSDFVL) ;
+1 NEW BPRET,DIR,X,Y,DIRUT
+2 SET BPRET="^"
+3 SET DIR(0)="F^::2"
SET DIR("A")=BPSPROM
+4 IF $LENGTH($GET(BPSDFVL))>0
SET DIR("B")=$GET(BPSDFVL)
+5 DO ^DIR
IF $DATA(DIRUT)
QUIT "^"
+6 SET $PIECE(BPRET,U)=Y
+7 QUIT BPRET
+8 ;
+9 ;/**
+10 ;check and process user input
+11 ;input:
+12 ; BPLINE - input string
+13 ; BPTYPE - expected user's selection on level
+14 ; of P-patient or C-claim or PC - both
+15 ; BPTMP1 - temporary global (VALMAR)
+16 ;output:
+17 ; piece 1:
+18 ; 1 - okay
+19 ; <0 - errors
+20 ; 0 - user wants to quit
+21 ; piece 2: patient ien #2
+22 ; piece 3: insurance ien #36
+23 ; piece 4: ptr to #9002313.59
+24 ; piece 5: 1st line for index(es) in LM "VALM" array
+25 ; piece 6: patient's index
+26 ; piece 7: claim's index
CHECKLN(BPLINE,BPTYPE,BPTMP1) ;*/
+1 NEW BPX,BPPATIND,BPCLMIND
+2 NEW BPDFN,BPSINSUR,BP59,BP1LN
+3 IF BPLINE="^"
QUIT 0
+4 SET BPPATIND=+$PIECE(BPLINE,".")
+5 ;the patient level doesn't exist
IF '$DATA(@BPTMP1@("LMIND",BPPATIND))
QUIT -1
+6 SET BPCLMIND=+$PIECE(BPLINE,".",2)
+7 ;P was requested but claim portion was provided
IF BPTYPE="P"
IF BPCLMIND>0
QUIT -2
+8 ;C was requested but claim portion was not provided
IF BPTYPE="C"
IF BPCLMIND=0
QUIT -3
+9 ;the claim level doesn't exist
IF '$DATA(@BPTMP1@("LMIND",BPPATIND,BPCLMIND))
QUIT -4
+10 SET BPDFN=$ORDER(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,0))
+11 ;error
IF +BPDFN=0
QUIT -5
+12 SET BPSINSUR=$ORDER(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,""))
+13 ;error
IF BPSINSUR=""
QUIT -6
+14 ;if fractional part was entered
+15 ;error
IF BPCLMIND>0
Begin DoDot:1
+16 SET BP59=$ORDER(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,BPSINSUR,0))
End DoDot:1
IF +BP59=0
QUIT -7
+17 IF BPCLMIND=0
SET BP59=0
+18 SET BP1LN=$ORDER(@BPTMP1@("LMIND",BPPATIND,BPCLMIND,BPDFN,BPSINSUR,BP59,0))
+19 ;error
IF +BP1LN=0
QUIT -7
+20 QUIT "1"_U_BPDFN_U_BPSINSUR_U_BP59_U_BP1LN_U_BPPATIND_U_BPCLMIND
+21 ;
+22 ;
+23 ;BPTMP = VALMAR
+24 ;input:
+25 ; BPROMPT - prompt text
+26 ; BPTYPE - expected user's selection on level
+27 ; of P-patient or C-claim or PC - both
+28 ; BPTMP - temporary global (like VALMAR)
+29 ; BPARRLN2 - to return results
+30 ;output :
+31 ; 1 if okay
+32 ; -1 -invalid format
+33 ; ^ - quit
+34 ; BPARRLN2 - Array(B59)="line# in VALM"^"PatientIndex.ClaimIndex"
+35 ;example:
+36 ; BPARR(30045.00001)=134^2.34
ASKLINES(BPROMPT,BPTYPE,BPARRLN2,BPTMP) ;
+1 NEW BPQ,BPXLN,BPN,BPLN,BPZ
+2 NEW BPL,BPCLM,BPDFLT
+3 NEW BPARRLN1,BPX1
+4 ;
+5 ; Attempt to determine default
+6 SET BPDFLT=$$DEFAULT(BPTYPE,BPTMP)
+7 ;
+8 SET BPSPROM="Select item(s)"
+9 SET BPLN=$$PROMPT(BPSPROM,BPDFLT)
+10 IF BPLN="^"
QUIT "^"
+11 SET BPLN=$PIECE(BPLN,U)
+12 SET BPQ=0
+13 FOR BPN=1:1
SET BPX1=$PIECE(BPLN,",",BPN)
if $LENGTH(BPX1)=0
QUIT
Begin DoDot:1
+14 SET BPZ=$$MKINDEXS(BPX1,BPTMP,.BPARRLN1)
+15 IF BPZ<1
SET BPQ=-1
+16 IF (BPZ=-1)!(BPZ=-2)
WRITE !,"Invalid format.",!
+17 IF (BPZ=-3)
WRITE !,"Not a valid selection.",!
End DoDot:1
if BPQ'=0
QUIT
+18 if BPQ=-1
QUIT -1
+19 ;
+20 NEW BPPAT,BPCLM
+21 SET BPPAT=0
FOR
SET BPPAT=$ORDER(BPARRLN1(BPPAT))
if BPPAT=""
QUIT
Begin DoDot:1
+22 SET BPCLM=0
FOR
SET BPCLM=$ORDER(BPARRLN1(BPPAT,BPCLM))
if BPCLM=""
QUIT
Begin DoDot:2
+23 SET BP1=$GET(BPARRLN1(BPPAT,BPCLM))
+24 if $LENGTH(BP1)=0
QUIT
+25 SET BPARRLN2(+$PIECE(BP1,U,4))=+$PIECE(BP1,U,5)_U_BPPAT_"."_BPCLM
End DoDot:2
End DoDot:1
+26 QUIT 1
+27 ;
+28 ;/**
+29 ;checks for dashes and if so then create a number of indexes for the range
+30 ;i.e. convert all "1.2-2.3" to "1.2,1.3,1.4,2.1,2.2,2.3"
+31 ;AND create entries in BPARR for all "right" indexes
+32 ;input:
+33 ;BPVAL - value to check (exmpl: "1.2-2.4")
+34 ;BPTMP1 - global ref with data (exmpl: VALMAR)
+35 ;BPARR - array with parsed line indexes
+36 ;output:
+37 ;Exmpl:
+38 ; BPARR(1.2)=""
+39 ; BPARR(1.3)=""
+40 ; ...
+41 ; returns:
+42 ; 1 - okay
+43 ; <0 invalid format
MKINDEXS(BPVAL,BPTMP1,BPARR) ;
+1 NEW BPFR,BPTO,BPQ,BPRET
+2 NEW BPPAT,BPCLM,BPCLSTRT,BPCLEND,BPQ2
+3 NEW BPFRPAT,BPTOPAT,BPFRCLM,BPTOCLM,BP1
+4 SET BPQ=0
+5 SET BPRET=1
+6 IF BPVAL'["-"
Begin DoDot:1
+7 SET BPPAT=$PIECE(BPVAL,".",1)
+8 ;invalid format, patient part is not numeric
IF BPPAT'=+BPPAT
SET BPRET=-1
QUIT
+9 SET BPCLM=$PIECE(BPVAL,".",2)
+10 ;if only patient index
+11 IF $LENGTH(BPCLM)=0
Begin DoDot:2
+12 SET BPQ2=0
+13 FOR BPCLM=1:1
Begin DoDot:3
+14 ;quit if there are no more claims for the patient
+15 SET BP1=$$CHECKLN(BPPAT_"."_BPCLM,"C",BPTMP1)
+16 IF BP1<1
SET BPQ2=1
QUIT
+17 SET BPARR(+BPPAT,+BPCLM)=BP1
End DoDot:3
if BPQ2'=0
QUIT
End DoDot:2
QUIT
+18 ;if only patient+claim index
+19 ;invalid format, claim portion is not numeric
IF BPCLM'=+BPCLM
SET BPRET=-2
QUIT
+20 SET BP1=$$CHECKLN(BPPAT_"."_BPCLM,"C",BPTMP1)
+21 ;not found
IF BP1<1
SET BPRET=-3
QUIT
+22 SET BPARR(+BPPAT,+BPCLM)=BP1
End DoDot:1
QUIT BPRET
+23 ;********* if contains "-"
+24 SET BPFR=$PIECE(BPVAL,"-",1)
+25 SET BPTO=$PIECE(BPVAL,"-",2)
+26 ;invalid format (to many dashes)
IF BPTO["-"
QUIT -3
+27 SET BPFRPAT=$PIECE(BPFR,".",1)
+28 SET BPTOPAT=$PIECE(BPTO,".",1)
+29 SET BPFRCLM=$PIECE(BPFR,".",2)
+30 IF $LENGTH(BPFRCLM)=0
SET BPFRCLM=1
+31 SET BPTOCLM=$PIECE(BPTO,".",2)
+32 IF $LENGTH(BPTOCLM)=0
SET BPTOCLM=999999
+33 ;invalid format, patient part is not numeric
IF BPFRPAT'=+BPFRPAT
QUIT -1
+34 ;invalid format, patient part is not numeric
IF BPTOPAT'=+BPTOPAT
QUIT -1
+35 ;invalid format, claim portion is not numeric
IF BPFRCLM'=+BPFRCLM
QUIT -2
+36 ;invalid format, claim portion is not numeric
IF BPTOCLM'=+BPTOCLM
QUIT -2
+37 FOR BPPAT=BPFRPAT:1:BPTOPAT
Begin DoDot:1
+38 IF BPPAT=BPFRPAT
SET BPCLSTRT=BPFRCLM
+39 IF '$TEST
SET BPCLSTRT=1
+40 IF BPPAT=BPTOPAT
SET BPCLEND=BPTOCLM
+41 IF '$TEST
SET BPCLEND=999999
+42 SET BPQ2=0
+43 FOR BPCLM=BPCLSTRT:1:BPCLEND
Begin DoDot:2
+44 ;quit if there are no more claims for the patient
+45 SET BP1=$$CHECKLN(BPPAT_"."_BPCLM,"C",BPTMP1)
+46 IF BP1<1
SET BPQ2=1
QUIT
+47 SET BPARR(+BPPAT,+BPCLM)=BP1
End DoDot:2
if BPQ2'=0
QUIT
End DoDot:1
+48 QUIT 1
+49 ;
+50 ; DEFAULT will return a value to be used as the default at the
+51 ; Select Item prompt if there is only one item on the list. If the
+52 ; user must enter a patient-level item (BPTYPE of "P"), the the
+53 ; patient number will be returned if only one. Otherwise the claim
+54 ; number will be returned if only one patient and one claim.
+55 ; Input: BPTYPE - P if user should enter a Patient
+56 ; C if user should enter a Claim
+57 ; PC if user may enter either
+58 ; BPLIST - temporary global (VALMAR)
+59 ; Output: $$DEFAULT - Either a patient number, or a claim number,
+60 ; or <blank> if neither could be defaulted
DEFAULT(BPTYPE,BPLIST) ; Determine default item number - BPS*1.0*21
+1 NEW BPSCLAIM,BPSPATIENT
+2 SET BPSPATIENT=$ORDER(@BPLIST@("LMIND",0))
+3 ; if not one patient, Quit ""
IF $ORDER(@BPLIST@("LMIND",BPSPATIENT))'=""
QUIT ""
+4 ; if BPTYPE is P(atient), then Quit with the patient
IF BPTYPE="P"
QUIT BPSPATIENT
+5 SET BPSCLAIM=$ORDER(@BPLIST@("LMIND",BPSPATIENT,0))
+6 ; if not one claim, Quit ""
IF $ORDER(@BPLIST@("LMIND",BPSPATIENT,BPSCLAIM))'=""
QUIT ""
+7 QUIT BPSPATIENT_"."_BPSCLAIM
+8 ;
