BPSSCRV2.m

BPSSCRV2 ;AITC/PD - ECME SCREEN CHANGE VIEW continued;1/17/2018

 ;;1.0;E CLAIMS MGMT ENGINE;**23**;JUN 2004;Build 44

 ;;Per VA Directive 6402, this routine should not be modified.

 ;USER SCREEN continued

 Q

 ;****

 ;

 ; New'ing of BPS* arrays and variables handled in routine BPSSCRCV

 ;

BPS106(BPARR) ; FIELD 1.06 - Rejects / Payables / Unstranded / All

BPS106A ;

 ; 

 S BPS106STR=",R,P,U,A,"

 S DIR(0)="FO^0:7"

 S DIR("A",1)=""

 S DIR("A",2)="     Select one of the following:"

 S DIR("A",3)=""

 S DIR("A",4)="          R         REJECTS"

 S DIR("A",5)="          P         PAYABLES"

 S DIR("A",6)="          U         UNSTRANDED"

 S DIR("A",7)="          A         ALL"

 S DIR("A",8)=""

 S DIR("A")="Display (R)ejects or (P)ayables or (U)nstranded or (A)ll"

 S DIR("B")="A"

 I $G(BPARR(1.06))'="" S DIR("B")=BPARR(1.06)

 S DIR("?",1)="Enter a single response or multiple responses separated by commas."

 S DIR("?",2)=" Example:"

 S DIR("?",3)="  P"

 S DIR("?")="  P,R"

 D ^DIR K DIR

 ;

 I $D(DIRUT) Q 0

 ;

 ; Loop through user input (returned in variable X).

 ; Display warning message if any user input selection is not included

 ; in the string of acceptable codes (BPS106STR) and re-prompt question.

 ; Assign valid selections to BPS106 array. This array will prevent

 ; duplicate entries from being saved to the user's profile.

 ;

 K BPS106

 S BPSERR=0

 S X=$TR(X,"rpua","RPUA")

 S X=$TR(X," ","")

 F BPSX=1:1:$L(X,",") D

 . S BPSSEL=$P(X,",",BPSX)

 . I BPS106STR'[(","_BPSSEL_",") W !," ",BPSSEL," is not a valid entry." S BPSERR=1 Q

 . S BPS106(BPSSEL)=""

 ;

 I $G(BPSERR)=1 G BPS106A

 ;

 ; If user included (A)ll as a selection, set profile setting to A.

 ;

 I $D(BPS106("A")) S BPARR(1.06)="A"

 E  D  ; User did not enter "A"

 . ; 

 . ; At this point user selections are valid and do not include "A".

 . ; Loop through valid user selections. Set selections into a

 . ; comma delimited string before assigning to BPARR array.

 . ; 

 . S BPSSEL=""

 . W !,?2,"Selected:"

 . F  S BPSSEL=$O(BPS106(BPSSEL)) Q:BPSSEL=""  D

 . . S BPS106=$G(BPS106)_BPSSEL_","

 . . I BPSSEL="P" W !,?10,"PAYABLES"

 . . I BPSSEL="U" W !,?10,"UNSTRANDED"

 . . I BPSSEL="R" W !,?10,"REJECTS"

 . S BPS106=$E(BPS106,1,($L(BPS106)-1))

 . S BPARR(1.06)=BPS106

 ;

 Q 1

 ;

 ; ^^^^^^^^^^ End of BPS106 Logic ^^^^^^^^^^

 ;

 ; ********** Start of BPS108 Logic **********

 ;

 ; BPS108STR = string of valid codes

 ; 

 ; Upon completion of prompt, values will be placed into a string delimited

 ; by commas. e.g. C,M

 ; 

 ; If user includes (A)ll as a code, only A will be stored in BPARR

 ; array. e.g. Entry of C,M,A will save as BPARR(1.08)="A"

 ; 

 ; User input values are temporary stored in array BPS108 to eliminate duplicate 

 ; entries. e.g. Entry of C,M,C will save as BPARR(1.08)="C,M"

 ;   

BPS108(BPARR) ; FIELD 1.08 - CMOP / Mail / Window / All

BPS108A ;

 ; 

 S BPS108STR=",C,M,W,A,"

 S DIR(0)="FO^0:7"

 S DIR("A",1)=""

 S DIR("A",2)="     Select one of the following:"

 S DIR("A",3)=""

 S DIR("A",4)="          C         CMOP"

 S DIR("A",5)="          M         MAIL"

 S DIR("A",6)="          W         WINDOW"

 S DIR("A",7)="          A         ALL"

 S DIR("A",8)=""

 S DIR("A")="Display (C)MOP or (M)ail or (W)indow or (A)ll"

 S DIR("B")="A" S:$G(BPARR(1.08))'="" DIR("B")=BPARR(1.08)

 S DIR("?",1)="Enter a single response or multiple responses separated by commas."

 S DIR("?",2)=" Example:"

 S DIR("?",3)="  C"

 S DIR("?")="  C,M"

 D ^DIR K DIR

 ;

 I $D(DIRUT) Q 0

 ;

 ; Loop through user input (returned in variable X).

 ; Display warning message if any user input selection is not included

 ; in the string of acceptable codes (BPS108STR) and re-prompt question.

 ; Assign valid selections to BPS108 array. This array will prevent

 ; duplicate entries from being saved to the user's profile.

 ;

 K BPS108

 S BPSERR=""

 S X=$TR(X,"cmwa","CMWA")

 S X=$TR(X," ","")

 F BPSX=1:1:$L(X,",") D

 . S BPSSEL=$P(X,",",BPSX)

 . I BPS108STR'[(","_BPSSEL_",") W !," ",BPSSEL," is not a valid entry." S BPSERR=1 Q

 . S BPS108(BPSSEL)=""

 ;

 I $G(BPSERR)=1 G BPS108A

 ;

 ; If user included (A)ll as a seleection, set profile setting to A.

 ;

 I $D(BPS108("A")) S BPARR(1.08)="A"

 E  D  ; User did not enter "A".

 . ;

 . ; At this point user selections are valid and do not include "A".

 . ; Loop through valid user selections. Set selections into a

 . ; comma delimited string before assigning to BPARR array.

 . ;

 . S BPSSEL=""

 . W !,?2,"Selected:"

 . F  S BPSSEL=$O(BPS108(BPSSEL)) Q:BPSSEL=""  D

 . . S BPS108=$G(BPS108)_BPSSEL_","

 . . I BPSSEL="C" W !,?10,"CMOP"

 . . I BPSSEL="M" W !,?10,"MAIL"

 . . I BPSSEL="W" W !,?10,"WINDOW"

 . S BPS108=$E(BPS108,1,($L(BPS108)-1))

 . S BPARR(1.08)=BPS108

 ;

 Q 1

 ;

 ; ^^^^^^^^^^ End of BPS108 Logic ^^^^^^^^^^

 ;

 ; ********** Start of BPS109 Logic **********

 ;

 ; BPS109STR = string of valid codes

 ;

 ; Upon completion of prompt, values will be placed into a string delimited

 ; by commas. e.g. P,R

 ;

 ; If user includes (A)ll as a code, only A will be stored in BPARR

 ; array. e.g. Entry of R,P,A will save as BPARR(1.09)="A"'

 ;

 ; User input values are temporary stored in array BPS106 to eliminate duplicate 

 ; entries. e.g. Entry of R,P,R will save as BPARR(1.09)="P,R"

 ;  

BPS109(BPARR) ; FIELD 1.09 - Realtime / Backbills / Pro Option / Resubmission / All

BPS109A ;

 ;

 S BPS109STR=",R,B,P,S,A,"

 S DIR(0)="FO^0:7"

 S DIR("A",1)=""

 S DIR("A",2)="     Select one of the following:"

 S DIR("A",3)=""

 S DIR("A",4)="          R         REALTIME"

 S DIR("A",5)="          B         BACKBILLS"

 S DIR("A",6)="          P         PRO OPTION"

 S DIR("A",7)="          S         RESUBMISSION"

 S DIR("A",8)="          A         ALL"

 S DIR("A",9)=""

 S DIR("A")="Display (R)ealTime, (B)ackbills, (P)RO Option, Re(S)ubmission or (A)ll"

 S DIR("B")="A"

 I $G(BPARR(1.09))'="" S DIR("B")=BPARR(1.09)

 S DIR("?",1)="Enter a single response or multiple responses separated by commas."

 S DIR("?",2)=" Example:"

 S DIR("?",3)="  B"

 S DIR("?")="  B,P"

 D ^DIR K DIR

 ;

 I $D(DIRUT) Q 0

 ;

 ; Loop through user input (returned in variable X).

 ; Display warning message if any user input selection is not included

 ; in the string of acceptable codes (BPS109STR) and re-prompt question.

 ; Assign valid selections to BPS109 array. This array will prevent

 ; duplicate entries from being saved to the user's profile.

 ;

 K BPS109

 S X=$TR(X,"rbpsa","RBPSA")

 S X=$TR(X," ","")

 S BPSERR=""

 F BPSX=1:1:$L(X,",") D

 . S BPSSEL=$P(X,",",BPSX)

 . I BPS109STR'[(","_BPSSEL_",") W !," ",BPSSEL," is not a valid entry." S BPSERR=1 Q

 . S BPS109(BPSSEL)=""

 ;

 I $G(BPSERR)=1 G BPS109A

 ;

 ; If user included (A)ll as a selection, set profile setting to A.

 ;

 I $D(BPS109("A")) S BPARR(1.09)="A"

 E  D  ; User did not enter "A".

 . ;

 . ; At this point user selections are valid and do not include "A".

 . ; Loop through valid user selections. Set selections into a

 . ; comma delimited string before assigning to BPARR array.

 . ;

 . S BPSSEL=""

 . W !,?2,"Selected:"

 . F  S BPSSEL=$O(BPS109(BPSSEL)) Q:BPSSEL=""  D

 . . S BPS109=$G(BPS109)_BPSSEL_","

 . . I BPSSEL="B" W !,?10,"BACKBILLS"

 . . I BPSSEL="P" W !,?10,"PRO OPTION"

 . . I BPSSEL="R" W !,?10,"REALTIME"

 . . I BPSSEL="S" W !,?10,"RESUBMISSION"

 . S BPS109=$E(BPS109,1,($L(BPS109)-1))

 . S BPARR(1.09)=BPS109

 ;

 Q 1

 ;

 ; ^^^^^^^^^^ End of BPS109 Logic ^^^^^^^^^^

 ;

 ; ********** Start of BPS110 / BPS115 Logic **********

 ;

 ; User input will be temporarily stored in BPS115AR for display to user 

 ; of selected REJECT CODES while in CV Action.

 ; 

 ; If R is selected, at least one REJECT CODE must be selected. If not, selection 

 ; will default to (A)ll and the current question will be re-prompted.

 ; 

 ; Upon completion of REJECT CODEs entry, values will be placed into a string 

 ; delimited by semicolons. e.g. BPARR(1.15)=";50;60;"

 ; 

 ; BPS115AR = array containing REJECT CODE information

 ; BPS115AR(BPS115)=BPS115NM    BPS115 = IEN from File #9002313.93

 ;                              BPS115NM = Reject Code Explanation 

 ; 

BPS110(BPARR) ; Fields 1.10 and 1.15 - Reject Code(s)

BPS110A ;

 ;

 N BPSI

 ;

 S BPINP=$$EDITFLD^BPSSCRCV(1.1,+BPDUZ7,"S^R:REJECT CODE;A:ALL","Display Specific (R)eject Code or (A)LL","ALL",.BPARR)

 I BPINP=-1 Q 0

 ;

 S BPSERR=0

 ; 

 ; If user selection is R, assign existing entry(s) into BPS115AR array.

 ;

 I $P(BPINP,U,2)="R" D

 . S BPS115=$G(BPARR(1.15))

 . I BPS115'="" D

 . . S BPSCNT=$L(BPS115,";")

 . . I BPSCNT=1 D

 . . . S BPS115CD=$$GET1^DIQ(9002313.93,BPS115,.01)

 . . . S BPS115NM=$$GET1^DIQ(9002313.93,BPS115,.02)

 . . . S BPS115AR(BPS115)=BPS115CD_"^"_BPS115NM

 . . I +BPSCNT>2 D

 . . . F BPSI=2:1:BPSCNT-1 D

 . . . . S BPS115X=$P(BPS115,";",BPSI)

 . . . . S BPS115CD=$$GET1^DIQ(9002313.93,BPS115X,.01)

 . . . . S BPS115NM=$$GET1^DIQ(9002313.93,BPS115X,.02)

 . . . . S BPS115AR(BPS115X)=BPS115CD_"^"_BPS115NM

 . ;

 . ; Display existing entry(s) to user.

 . ; 

 . I $D(BPS115AR) D

 . . W !,?2,"Selected:"

 . . S BPS115="" F  S BPS115=$O(BPS115AR(BPS115)) Q:BPS115=""  D

 . . . W !,?10,$P(BPS115AR(BPS115),"^")

 . . . W ?20,$P(BPS115AR(BPS115),"^",2)

 . ;

 . S BPS115="" F  D  Q:BPS115=-1

 . . S DIR0="P^BPSF(9002313.93,"

 . . S PRMTMSG="Select Reject Code"

 . . S DFLTVAL=""

 . . S BPS115=$$PROMPT^BPSSCRCV(DIR0,PRMTMSG,DFLTVAL)

 . . ; 

 . . ; Exit 'Select Reject Code' loop if user entered nil.

 . . ; 

 . . I BPS115=-1 Q

 . . ;

 . . S BPS115CD=$$GET1^DIQ(9002313.93,BPS115,.01)

 . . S BPS115NM=$$GET1^DIQ(9002313.93,BPS115,.02)

 . . 

 . . ;

 . . ; If entry exists in BPS115AR array, prompt user to delete from list.

 . . ; 

 . . I $D(BPS115AR(BPS115)) D

 . . . S DIR(0)="S^Y:YES;N:NO"

 . . . S DIR("A")="Delete "_$P(BPS115AR(BPS115),"^")_" from your list?"

 . . . S DIR("B")="NO"

 . . . D ^DIR

 . . . I Y="Y" K BPS115AR(BPS115)

 . . . ; 

 . . E  D

 . . . ; 

 . . . ; Set new entry intp BPS115AR array.

 . . . ; 

 . . . S BPS115AR(BPS115)=BPS115CD_"^"_BPS115NM

 . . ;

 . . ; Display existing entry(s) to user.

 . . ; 

 . . I $D(BPS115AR) D

 . . . W !,?2,"Selected:"

 . . . S BPS115="" F  S BPS115=$O(BPS115AR(BPS115)) Q:BPS115=""  D

 . . . . W !,?10,$P(BPS115AR(BPS115),"^")

 . . . . W ?20,$P(BPS115AR(BPS115),"^",2)

 . ;

 . ; If user selected (R)eject but has not selected any Reject Codes,

 . ; set profile setting to ALL and set BPSERR flag to re-prompt question.

 . ;

 . I '$D(BPS115AR) S BPARR(1.1)="A",BPARR(1.15)="" S BPSERR=1 Q

 . ;

 . ; Loop through selected reject codes, setting selected reject codes into

 . ; BPARR array - delimited by semi-colon. 

 . ; 

 . S BPARR(1.15)=";"

 . S BPS115=0 F  S BPS115=$O(BPS115AR(BPS115)) Q:+BPS115=0  S BPARR(1.15)=BPARR(1.15)_BPS115_";"

 E  D  ; User selected ALL

 . S BPARR(1.1)="A"

 . S BPARR(1.15)=""

 ; 

 ; If BPSERR flag is 1, re-prompt question.

 ; 

 I $G(BPSERR)=1 G BPS110A

 ;

 Q 1

 ;

 ; ^^^^^^^^^^ End of BPS110 / BPS115 Logic ^^^^^^^^^^

 ;

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---BPSSCRV2   11183     printed  Apr 09, 2024@20:58:01                                                                                                                                                                                                   Page 2

BPSSCRV2  ;AITC/PD - ECME SCREEN CHANGE VIEW continued;1/17/2018

 +1       ;;1.0;E CLAIMS MGMT ENGINE;**23**;JUN 2004;Build 44

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;USER SCREEN continued

 +4        QUIT 

 +5       ;****

 +6       ;

 +7       ; New'ing of BPS* arrays and variables handled in routine BPSSCRCV

 +8       ;

BPS106(BPARR) ; FIELD 1.06 - Rejects / Payables / Unstranded / All

BPS106A   ;

 +1       ; 

 +2        SET BPS106STR=",R,P,U,A,"

 +3        SET DIR(0)="FO^0:7"

 +4        SET DIR("A",1)=""

 +5        SET DIR("A",2)="     Select one of the following:"

 +6        SET DIR("A",3)=""

 +7        SET DIR("A",4)="          R         REJECTS"

 +8        SET DIR("A",5)="          P         PAYABLES"

 +9        SET DIR("A",6)="          U         UNSTRANDED"

 +10       SET DIR("A",7)="          A         ALL"

 +11       SET DIR("A",8)=""

 +12       SET DIR("A")="Display (R)ejects or (P)ayables or (U)nstranded or (A)ll"

 +13       SET DIR("B")="A"

 +14       IF $GET(BPARR(1.06))'=""

               SET DIR("B")=BPARR(1.06)

 +15       SET DIR("?",1)="Enter a single response or multiple responses separated by commas."

 +16       SET DIR("?",2)=" Example:"

 +17       SET DIR("?",3)="  P"

 +18       SET DIR("?")="  P,R"

 +19       DO ^DIR

           KILL DIR

 +20      ;

 +21       IF $DATA(DIRUT)

               QUIT 0

 +22      ;

 +23      ; Loop through user input (returned in variable X).

 +24      ; Display warning message if any user input selection is not included

 +25      ; in the string of acceptable codes (BPS106STR) and re-prompt question.

 +26      ; Assign valid selections to BPS106 array. This array will prevent

 +27      ; duplicate entries from being saved to the user's profile.

 +28      ;

 +29       KILL BPS106

 +30       SET BPSERR=0

 +31       SET X=$TRANSLATE(X,"rpua","RPUA")

 +32       SET X=$TRANSLATE(X," ","")

 +33       FOR BPSX=1:1:$LENGTH(X,",")

               Begin DoDot:1

 +34               SET BPSSEL=$PIECE(X,",",BPSX)

 +35               IF BPS106STR'[(","_BPSSEL_",")

                       WRITE !," ",BPSSEL," is not a valid entry."

                       SET BPSERR=1

                       QUIT 

 +36               SET BPS106(BPSSEL)=""

               End DoDot:1

 +37      ;

 +38       IF $GET(BPSERR)=1

               GOTO BPS106A

 +39      ;

 +40      ; If user included (A)ll as a selection, set profile setting to A.

 +41      ;

 +42       IF $DATA(BPS106("A"))

               SET BPARR(1.06)="A"

 +43      ; User did not enter "A"

          IF '$TEST

               Begin DoDot:1

 +44      ; 

 +45      ; At this point user selections are valid and do not include "A".

 +46      ; Loop through valid user selections. Set selections into a

 +47      ; comma delimited string before assigning to BPARR array.

 +48      ; 

 +49               SET BPSSEL=""

 +50               WRITE !,?2,"Selected:"

 +51               FOR 

                       SET BPSSEL=$ORDER(BPS106(BPSSEL))

                       if BPSSEL=""

                           QUIT 

                       Begin DoDot:2

 +52                       SET BPS106=$GET(BPS106)_BPSSEL_","

 +53                       IF BPSSEL="P"

                               WRITE !,?10,"PAYABLES"

 +54                       IF BPSSEL="U"

                               WRITE !,?10,"UNSTRANDED"

 +55                       IF BPSSEL="R"

                               WRITE !,?10,"REJECTS"

                       End DoDot:2

 +56               SET BPS106=$EXTRACT(BPS106,1,($LENGTH(BPS106)-1))

 +57               SET BPARR(1.06)=BPS106

               End DoDot:1

 +58      ;

 +59       QUIT 1

 +60      ;

 +61      ; ^^^^^^^^^^ End of BPS106 Logic ^^^^^^^^^^

 +62      ;

 +63      ; ********** Start of BPS108 Logic **********

 +64      ;

 +65      ; BPS108STR = string of valid codes

 +66      ; 

 +67      ; Upon completion of prompt, values will be placed into a string delimited

 +68      ; by commas. e.g. C,M

 +69      ; 

 +70      ; If user includes (A)ll as a code, only A will be stored in BPARR

 +71      ; array. e.g. Entry of C,M,A will save as BPARR(1.08)="A"

 +72      ; 

 +73      ; User input values are temporary stored in array BPS108 to eliminate duplicate 

 +74      ; entries. e.g. Entry of C,M,C will save as BPARR(1.08)="C,M"

 +75      ;   

BPS108(BPARR) ; FIELD 1.08 - CMOP / Mail / Window / All

BPS108A   ;

 +1       ; 

 +2        SET BPS108STR=",C,M,W,A,"

 +3        SET DIR(0)="FO^0:7"

 +4        SET DIR("A",1)=""

 +5        SET DIR("A",2)="     Select one of the following:"

 +6        SET DIR("A",3)=""

 +7        SET DIR("A",4)="          C         CMOP"

 +8        SET DIR("A",5)="          M         MAIL"

 +9        SET DIR("A",6)="          W         WINDOW"

 +10       SET DIR("A",7)="          A         ALL"

 +11       SET DIR("A",8)=""

 +12       SET DIR("A")="Display (C)MOP or (M)ail or (W)indow or (A)ll"

 +13       SET DIR("B")="A"

           if $GET(BPARR(1.08))'=""

               SET DIR("B")=BPARR(1.08)

 +14       SET DIR("?",1)="Enter a single response or multiple responses separated by commas."

 +15       SET DIR("?",2)=" Example:"

 +16       SET DIR("?",3)="  C"

 +17       SET DIR("?")="  C,M"

 +18       DO ^DIR

           KILL DIR

 +19      ;

 +20       IF $DATA(DIRUT)

               QUIT 0

 +21      ;

 +22      ; Loop through user input (returned in variable X).

 +23      ; Display warning message if any user input selection is not included

 +24      ; in the string of acceptable codes (BPS108STR) and re-prompt question.

 +25      ; Assign valid selections to BPS108 array. This array will prevent

 +26      ; duplicate entries from being saved to the user's profile.

 +27      ;

 +28       KILL BPS108

 +29       SET BPSERR=""

 +30       SET X=$TRANSLATE(X,"cmwa","CMWA")

 +31       SET X=$TRANSLATE(X," ","")

 +32       FOR BPSX=1:1:$LENGTH(X,",")

               Begin DoDot:1

 +33               SET BPSSEL=$PIECE(X,",",BPSX)

 +34               IF BPS108STR'[(","_BPSSEL_",")

                       WRITE !," ",BPSSEL," is not a valid entry."

                       SET BPSERR=1

                       QUIT 

 +35               SET BPS108(BPSSEL)=""

               End DoDot:1

 +36      ;

 +37       IF $GET(BPSERR)=1

               GOTO BPS108A

 +38      ;

 +39      ; If user included (A)ll as a seleection, set profile setting to A.

 +40      ;

 +41       IF $DATA(BPS108("A"))

               SET BPARR(1.08)="A"

 +42      ; User did not enter "A".

          IF '$TEST

               Begin DoDot:1

 +43      ;

 +44      ; At this point user selections are valid and do not include "A".

 +45      ; Loop through valid user selections. Set selections into a

 +46      ; comma delimited string before assigning to BPARR array.

 +47      ;

 +48               SET BPSSEL=""

 +49               WRITE !,?2,"Selected:"

 +50               FOR 

                       SET BPSSEL=$ORDER(BPS108(BPSSEL))

                       if BPSSEL=""

                           QUIT 

                       Begin DoDot:2

 +51                       SET BPS108=$GET(BPS108)_BPSSEL_","

 +52                       IF BPSSEL="C"

                               WRITE !,?10,"CMOP"

 +53                       IF BPSSEL="M"

                               WRITE !,?10,"MAIL"

 +54                       IF BPSSEL="W"

                               WRITE !,?10,"WINDOW"

                       End DoDot:2

 +55               SET BPS108=$EXTRACT(BPS108,1,($LENGTH(BPS108)-1))

 +56               SET BPARR(1.08)=BPS108

               End DoDot:1

 +57      ;

 +58       QUIT 1

 +59      ;

 +60      ; ^^^^^^^^^^ End of BPS108 Logic ^^^^^^^^^^

 +61      ;

 +62      ; ********** Start of BPS109 Logic **********

 +63      ;

 +64      ; BPS109STR = string of valid codes

 +65      ;

 +66      ; Upon completion of prompt, values will be placed into a string delimited

 +67      ; by commas. e.g. P,R

 +68      ;

 +69      ; If user includes (A)ll as a code, only A will be stored in BPARR

 +70      ; array. e.g. Entry of R,P,A will save as BPARR(1.09)="A"'

 +71      ;

 +72      ; User input values are temporary stored in array BPS106 to eliminate duplicate 

 +73      ; entries. e.g. Entry of R,P,R will save as BPARR(1.09)="P,R"

 +74      ;  

BPS109(BPARR) ; FIELD 1.09 - Realtime / Backbills / Pro Option / Resubmission / All

BPS109A   ;

 +1       ;

 +2        SET BPS109STR=",R,B,P,S,A,"

 +3        SET DIR(0)="FO^0:7"

 +4        SET DIR("A",1)=""

 +5        SET DIR("A",2)="     Select one of the following:"

 +6        SET DIR("A",3)=""

 +7        SET DIR("A",4)="          R         REALTIME"

 +8        SET DIR("A",5)="          B         BACKBILLS"

 +9        SET DIR("A",6)="          P         PRO OPTION"

 +10       SET DIR("A",7)="          S         RESUBMISSION"

 +11       SET DIR("A",8)="          A         ALL"

 +12       SET DIR("A",9)=""

 +13       SET DIR("A")="Display (R)ealTime, (B)ackbills, (P)RO Option, Re(S)ubmission or (A)ll"

 +14       SET DIR("B")="A"

 +15       IF $GET(BPARR(1.09))'=""

               SET DIR("B")=BPARR(1.09)

 +16       SET DIR("?",1)="Enter a single response or multiple responses separated by commas."

 +17       SET DIR("?",2)=" Example:"

 +18       SET DIR("?",3)="  B"

 +19       SET DIR("?")="  B,P"

 +20       DO ^DIR

           KILL DIR

 +21      ;

 +22       IF $DATA(DIRUT)

               QUIT 0

 +23      ;

 +24      ; Loop through user input (returned in variable X).

 +25      ; Display warning message if any user input selection is not included

 +26      ; in the string of acceptable codes (BPS109STR) and re-prompt question.

 +27      ; Assign valid selections to BPS109 array. This array will prevent

 +28      ; duplicate entries from being saved to the user's profile.

 +29      ;

 +30       KILL BPS109

 +31       SET X=$TRANSLATE(X,"rbpsa","RBPSA")

 +32       SET X=$TRANSLATE(X," ","")

 +33       SET BPSERR=""

 +34       FOR BPSX=1:1:$LENGTH(X,",")

               Begin DoDot:1

 +35               SET BPSSEL=$PIECE(X,",",BPSX)

 +36               IF BPS109STR'[(","_BPSSEL_",")

                       WRITE !," ",BPSSEL," is not a valid entry."

                       SET BPSERR=1

                       QUIT 

 +37               SET BPS109(BPSSEL)=""

               End DoDot:1

 +38      ;

 +39       IF $GET(BPSERR)=1

               GOTO BPS109A

 +40      ;

 +41      ; If user included (A)ll as a selection, set profile setting to A.

 +42      ;

 +43       IF $DATA(BPS109("A"))

               SET BPARR(1.09)="A"

 +44      ; User did not enter "A".

          IF '$TEST

               Begin DoDot:1

 +45      ;

 +46      ; At this point user selections are valid and do not include "A".

 +47      ; Loop through valid user selections. Set selections into a

 +48      ; comma delimited string before assigning to BPARR array.

 +49      ;

 +50               SET BPSSEL=""

 +51               WRITE !,?2,"Selected:"

 +52               FOR 

                       SET BPSSEL=$ORDER(BPS109(BPSSEL))

                       if BPSSEL=""

                           QUIT 

                       Begin DoDot:2

 +53                       SET BPS109=$GET(BPS109)_BPSSEL_","

 +54                       IF BPSSEL="B"

                               WRITE !,?10,"BACKBILLS"

 +55                       IF BPSSEL="P"

                               WRITE !,?10,"PRO OPTION"

 +56                       IF BPSSEL="R"

                               WRITE !,?10,"REALTIME"

 +57                       IF BPSSEL="S"

                               WRITE !,?10,"RESUBMISSION"

                       End DoDot:2

 +58               SET BPS109=$EXTRACT(BPS109,1,($LENGTH(BPS109)-1))

 +59               SET BPARR(1.09)=BPS109

               End DoDot:1

 +60      ;

 +61       QUIT 1

 +62      ;

 +63      ; ^^^^^^^^^^ End of BPS109 Logic ^^^^^^^^^^

 +64      ;

 +65      ; ********** Start of BPS110 / BPS115 Logic **********

 +66      ;

 +67      ; User input will be temporarily stored in BPS115AR for display to user 

 +68      ; of selected REJECT CODES while in CV Action.

 +69      ; 

 +70      ; If R is selected, at least one REJECT CODE must be selected. If not, selection 

 +71      ; will default to (A)ll and the current question will be re-prompted.

 +72      ; 

 +73      ; Upon completion of REJECT CODEs entry, values will be placed into a string 

 +74      ; delimited by semicolons. e.g. BPARR(1.15)=";50;60;"

 +75      ; 

 +76      ; BPS115AR = array containing REJECT CODE information

 +77      ; BPS115AR(BPS115)=BPS115NM    BPS115 = IEN from File #9002313.93

 +78      ;                              BPS115NM = Reject Code Explanation 

 +79      ; 

BPS110(BPARR) ; Fields 1.10 and 1.15 - Reject Code(s)

BPS110A   ;

 +1       ;

 +2        NEW BPSI

 +3       ;

 +4        SET BPINP=$$EDITFLD^BPSSCRCV(1.1,+BPDUZ7,"S^R:REJECT CODE;A:ALL","Display Specific (R)eject Code or (A)LL","ALL",.BPARR)

 +5        IF BPINP=-1

               QUIT 0

 +6       ;

 +7        SET BPSERR=0

 +8       ; 

 +9       ; If user selection is R, assign existing entry(s) into BPS115AR array.

 +10      ;

 +11       IF $PIECE(BPINP,U,2)="R"

               Begin DoDot:1

 +12               SET BPS115=$GET(BPARR(1.15))

 +13               IF BPS115'=""

                       Begin DoDot:2

 +14                       SET BPSCNT=$LENGTH(BPS115,";")

 +15                       IF BPSCNT=1

                               Begin DoDot:3

 +16                               SET BPS115CD=$$GET1^DIQ(9002313.93,BPS115,.01)

 +17                               SET BPS115NM=$$GET1^DIQ(9002313.93,BPS115,.02)

 +18                               SET BPS115AR(BPS115)=BPS115CD_"^"_BPS115NM

                               End DoDot:3

 +19                       IF +BPSCNT>2

                               Begin DoDot:3

 +20                               FOR BPSI=2:1:BPSCNT-1

                                       Begin DoDot:4

 +21                                       SET BPS115X=$PIECE(BPS115,";",BPSI)

 +22                                       SET BPS115CD=$$GET1^DIQ(9002313.93,BPS115X,.01)

 +23                                       SET BPS115NM=$$GET1^DIQ(9002313.93,BPS115X,.02)

 +24                                       SET BPS115AR(BPS115X)=BPS115CD_"^"_BPS115NM

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

 +25      ;

 +26      ; Display existing entry(s) to user.

 +27      ; 

 +28               IF $DATA(BPS115AR)

                       Begin DoDot:2

 +29                       WRITE !,?2,"Selected:"

 +30                       SET BPS115=""

                           FOR 

                               SET BPS115=$ORDER(BPS115AR(BPS115))

                               if BPS115=""

                                   QUIT 

                               Begin DoDot:3

 +31                               WRITE !,?10,$PIECE(BPS115AR(BPS115),"^")

 +32                               WRITE ?20,$PIECE(BPS115AR(BPS115),"^",2)

                               End DoDot:3

                       End DoDot:2

 +33      ;

 +34               SET BPS115=""

                   FOR 

                       Begin DoDot:2

 +35                       SET DIR0="P^BPSF(9002313.93,"

 +36                       SET PRMTMSG="Select Reject Code"

 +37                       SET DFLTVAL=""

 +38                       SET BPS115=$$PROMPT^BPSSCRCV(DIR0,PRMTMSG,DFLTVAL)

 +39      ; 

 +40      ; Exit 'Select Reject Code' loop if user entered nil.

 +41      ; 

 +42                       IF BPS115=-1

                               QUIT 

 +43      ;

 +44                       SET BPS115CD=$$GET1^DIQ(9002313.93,BPS115,.01)

 +45                       SET BPS115NM=$$GET1^DIQ(9002313.93,BPS115,.02)

 +46  +47 ;

 +48      ; If entry exists in BPS115AR array, prompt user to delete from list.

 +49      ; 

 +50                       IF $DATA(BPS115AR(BPS115))

                               Begin DoDot:3

 +51                               SET DIR(0)="S^Y:YES;N:NO"

 +52                               SET DIR("A")="Delete "_$PIECE(BPS115AR(BPS115),"^")_" from your list?"

 +53                               SET DIR("B")="NO"

 +54                               DO ^DIR

 +55                               IF Y="Y"

                                       KILL BPS115AR(BPS115)

 +56      ; 

                               End DoDot:3

 +57                      IF '$TEST

                               Begin DoDot:3

 +58      ; 

 +59      ; Set new entry intp BPS115AR array.

 +60      ; 

 +61                               SET BPS115AR(BPS115)=BPS115CD_"^"_BPS115NM

                               End DoDot:3

 +62      ;

 +63      ; Display existing entry(s) to user.

 +64      ; 

 +65                       IF $DATA(BPS115AR)

                               Begin DoDot:3

 +66                               WRITE !,?2,"Selected:"

 +67                               SET BPS115=""

                                   FOR 

                                       SET BPS115=$ORDER(BPS115AR(BPS115))

                                       if BPS115=""

                                           QUIT 

                                       Begin DoDot:4

 +68                                       WRITE !,?10,$PIECE(BPS115AR(BPS115),"^")

 +69                                       WRITE ?20,$PIECE(BPS115AR(BPS115),"^",2)

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

                       if BPS115=-1

                           QUIT 

 +70      ;

 +71      ; If user selected (R)eject but has not selected any Reject Codes,

 +72      ; set profile setting to ALL and set BPSERR flag to re-prompt question.

 +73      ;

 +74               IF '$DATA(BPS115AR)

                       SET BPARR(1.1)="A"

                       SET BPARR(1.15)=""

                       SET BPSERR=1

                       QUIT 

 +75      ;

 +76      ; Loop through selected reject codes, setting selected reject codes into

 +77      ; BPARR array - delimited by semi-colon. 

 +78      ; 

 +79               SET BPARR(1.15)=";"

 +80               SET BPS115=0

                   FOR 

                       SET BPS115=$ORDER(BPS115AR(BPS115))

                       if +BPS115=0

                           QUIT 

                       SET BPARR(1.15)=BPARR(1.15)_BPS115_";"

               End DoDot:1

 +81      ; User selected ALL

          IF '$TEST

               Begin DoDot:1

 +82               SET BPARR(1.1)="A"

 +83               SET BPARR(1.15)=""

               End DoDot:1

 +84      ; 

 +85      ; If BPSERR flag is 1, re-prompt question.

 +86      ; 

 +87       IF $GET(BPSERR)=1

               GOTO BPS110A

 +88      ;

 +89       QUIT 1

 +90      ;

 +91      ; ^^^^^^^^^^ End of BPS110 / BPS115 Logic ^^^^^^^^^^

 +92      ;

 +93       QUIT