- 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 Dec 13, 2024@01:53:22 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 ;