BPSSCRV1.m

BPSSCRV1 ;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

 ; 

BPS201(BPARR) ; FIELD 2.01 - Eligibility Type

BPS201A ;

 ;

 S BPS201STR=",V,T,C,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)="          V         VETERAN"

 S DIR("A",5)="          T         TRICARE"

 S DIR("A",6)="          C         CHAMPVA"

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

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

 S DIR("A")="Select One or Many Eligibility Types or (A)ll"

 S DIR("B")="V"

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

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

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

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

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

 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 (BPS201STR) and re-prompt question.

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

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

 ;

 K BPS201

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

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

 S BPSERR=0

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

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

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

 . S BPS201(BPSSEL)=""

 ; 

 I $G(BPSERR)=1 G BPS201A

 ; 

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

 ;

 I $D(BPS201("A")) S BPARR(2.01)="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(BPS201(BPSSEL)) Q:BPSSEL=""  D

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

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

 . . I BPSSEL="T" W !,?10,"TRICARE"

 . . I BPSSEL="V" W !,?10,"VETERAN"

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

 . S BPARR(2.01)=BPS201

 ;

 Q 1

 ;

 ; ^^^^^^^^^^ End of BPS201 Logic ^^^^^^^^^^

 ;

 ; ********** Start of BPS101 / BPS116 Logic **********

 ;

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

 ; of selected USERS while in CV Action.

 ; 

 ; If U is selected, at least one USER must be selected. If not, selection 

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

 ; 

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

 ; delimited by semicolons. e.g. BPARR(1.16)=";12345;56789;"

 ; 

 ; BPS116AR = array containing USER information

 ; BPS116AR(BPS116)=""    BPS116 = IEN from New Person File #200

 ; BPS116AR("B",BPS116NM) BPS116NM = User Name - Index used to display 

 ; selected USERs in alphabetical order while in CV Action.

 ;

BPS101(BPARR) ; Fields 1.01 and 1.16 - User(s)

BPS101A ;

 ;

 N BPSI

 ;

 S BPINP=$$EDITFLD^BPSSCRCV(1.01,+BPDUZ7,"S^U:USER;A:ALL","Display One or Many ECME (U)sers or (A)LL","ALL",.BPARR)

 I BPINP=-1 Q 0

 ;

 S BPSERR=0

 ;

 ; If user selection is U, assign existing entry(s) into BPS116AR array.

 ;

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

 . S BPS116=$G(BPARR(1.16))

 . I BPS116'="" D

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

 . . I BPSCNT=1 D

 . . . S BPS116NM=$$GET1^DIQ(200,BPS116,.01)

 . . . I $G(BPS116NM)'="" S BPS116AR(BPS116)="",BPS116AR("B",BPS116NM)=""

 . . I +BPSCNT>2 D

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

 . . . . S BPS116X=$P(BPS116,";",BPSI),BPS116NM=$$GET1^DIQ(200,BPS116X,.01)

 . . . . I $G(BPS116NM)'="" S BPS116AR(BPS116X)="",BPS116AR("B",BPS116NM)=""

 . ;

 . ; Display existing entry(s) to user.

 . ;

 . I $D(BPS116AR) D

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

 . . S BPS116NM="" F  S BPS116NM=$O(BPS116AR("B",BPS116NM)) Q:BPS116NM=""  W !,?10,BPS116NM

 . ;

 . W !!,"Enter a user to select."

 . W !,"Once all users are selected, hit enter without making a selection.",!

 . ;

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

 . . S DIR0="P^VA(200,"

 . . S PRMTMSG="Select User"

 . . S DFLTVAL=""

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

 . . ;

 . . ; Exit 'Select User' loop if user entered nil.

 . . ; 

 . . I BPS116=-1 Q

 . . ; 

 . . S BPS116NM=$$GET1^DIQ(200,BPS116,.01)

 . . ;

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

 . . ; 

 . . I $D(BPS116AR(BPS116)) D

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

 . . . S DIR("A")="Delete "_BPS116NM_" from your list?"

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

 . . . D ^DIR

 . . . I Y="Y" K BPS116AR(BPS116),BPS116AR("B",BPS116NM)

 . . . ; 

 . . E  D

 . . . ; 

 . . . ; Set new entry into BPS116AR array.

 . . . ;

 . . . I $G(BPS116NM)'="" S BPS116AR(BPS116)="",BPS116AR("B",BPS116NM)=""

 . . ;

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

 . . ;

 . . I $D(BPS116AR) D

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

 . . . S BPS116NM="" F  S BPS116NM=$O(BPS116AR("B",BPS116NM)) Q:BPS116NM=""  W !,?10,BPS116NM

 . ;

 . ; If user selected (U)ser but has not selected any users,

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

 .; 

 . I '$D(BPS116AR) S BPARR(1.01)="A",BPARR(1.16)="" S BPSERR=1 Q

 . ;

 . ; Loop through selected users, setting selected users into 

 . ; BPARR array - delimited by semi-colon.

 . ; 

 . S BPARR(1.16)=";"

 . S BPS116=0 F  S BPS116=$O(BPS116AR(BPS116)) Q:+BPS116=0  S BPARR(1.16)=BPARR(1.16)_BPS116_";"

 E  D  ; User selected ALL

 . S BPARR(1.01)="A"

 . S BPARR(1.16)=""

 ;

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

 ; 

 I $G(BPSERR)=1 G BPS101A

 ;

 Q 1

 ;

 ; ^^^^^^^^^^ End of BPS101 / BPS116 Logic ^^^^^^^^^^

 ;

 ; ********** Start of BPS102 / BPS117 Logic **********

 ;

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

 ; of selected PATIENTS while in CV Action.

 ; 

 ; If P is selected, at least one PATIENT must be selected. If not, selection 

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

 ; 

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

 ; delimited by semicolons. e.g. BPARR(1.17)=";12345;56789;"

 ; 

 ; BPS117AR = array containing PATIENT information

 ; BPS117AR(BPS117)=""    BPS117 = IEN from Patient File ^DPT

 ; BPS117AR("B",BPS117M) BPS117NM = Patient Name - Index used to display 

 ; selected PATIENTs in alphabetical order while in CV Action. 

 ;

BPS102(BPARR) ; Fields 1.02 and 1.17 - Patient(s)

BPS102A ;

 ;

 N BPSI

 ;

 S BPINP=$$EDITFLD^BPSSCRCV(1.02,+BPDUZ7,"S^P:PATIENT;A:ALL","Display One or Many (P)atients or (A)LL","ALL",.BPARR)

 I BPINP=-1 Q 0

 ;

 S BPSERR=0

 ;

 ; If user selection is P, assign existing entry(s) into BPS117AR array.

 ;

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

 . S BPS117=$G(BPARR(1.17))

 . I BPS117'="" D

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

 . . I BPSCNT=1 D

 . . . S BPS117NM=$$GET1^DIQ(2,BPS117,.01)

 . . . I $G(BPS117NM)'="" S BPS117AR(BPS117)="",BPS117AR("B",BPS117NM)=""

 . . I +BPSCNT>2 D

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

 . . . . S BPS117X=$P(BPS117,";",BPSI),BPS117NM=$$GET1^DIQ(2,BPS117X,.01)

 . . . . I $G(BPS117NM)'="" S BPS117AR(BPS117X)="",BPS117AR("B",BPS117NM)=""

 . ;

 . ; Display existing entry(s) to user.

 . ; 

 . I $D(BPS117AR) D

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

 . . S BPS117NM="" F  S BPS117NM=$O(BPS117AR("B",BPS117NM)) Q:BPS117NM=""  W !,?10,BPS117NM

 . ;

 . W !!,"Enter a patient to select."

 . W !,"Once all patients are selected, hit enter without making a selection.",!

 . ;

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

 . . S DIR0="P^DPT("

 . . S PRMTMSG="Select Patient"

 . . S DFLTVAL=""

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

 . . ;

 . . ; Exit 'Select Patient' loop if user entered nil.

 . . ; 

 . . I BPS117=-1 Q

 . . ; 

 . . S BPS117NM=$$GET1^DIQ(2,BPS117,.01)

 . . ;

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

 . . ; 

 . . I $D(BPS117AR(BPS117)) D

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

 . . . S DIR("A")="Delete "_BPS117NM_" from your list?"

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

 . . . D ^DIR

 . . . I Y="Y" K BPS117AR(BPS117),BPS117AR("B",BPS117NM)

 . . . ; 

 . . E  D

 . . . ; 

 . . . ; Set new entry into BPS117AR array.

 . . . ; 

 . . . I $G(BPS117NM)'="" S BPS117AR(BPS117)="",BPS117AR("B",BPS117NM)=""

 . . ;

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

 . . ; 

 . . I $D(BPS117AR) D

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

 . . . S BPS117NM="" F  S BPS117NM=$O(BPS117AR("B",BPS117NM)) Q:BPS117NM=""  W !,?10,BPS117NM

 . ;

 . ; If user selected (P)atient but has not selected any patients,

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

 . ; 

 . I '$D(BPS117AR) S BPARR(1.02)="A",BPARR(1.17)="" S BPSERR=1 Q

 . ;

 . ; Loop through selected patients, setting selected patients into

 . ; BPARR array - delimited by semi-colon.

 . ;

 . S BPARR(1.17)=";"

 . S BPS117=0 F  S BPS117=$O(BPS117AR(BPS117)) Q:+BPS117=0  S BPARR(1.17)=BPARR(1.17)_BPS117_";"

 E  D  ; User selected ALL

 . S BPARR(1.02)="A"

 . S BPARR(1.17)=""

 ;

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

 ; 

 I $G(BPSERR)=1 G BPS102A

 ;

 Q 1

 ;

 ; ^^^^^^^^^^ End of BPS102 / BPS117 Logic ^^^^^^^^^^

 ;

 ; ********** Start of BPS103 / BPS118 Logic **********

 ;

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

 ; of selected RXs while in CV Action.

 ; 

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

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

 ; 

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

 ; delimited by semicolons. e.g. BPARR(1.18)=";12345;56789;"

 ; 

 ; BPS118AR = array containing RX information

 ; BPS118AR(BPS118)=""  BPS118 = IEN from Prescription File #52

 ; BPS118AR("B",BPSRXN) BPSRXN = RX Number - Index used to display 

 ; selected RXs in numerical order while in CV Action.

 ;   

BPS103(BPARR) ; Fields 1.03 and 1.18 - Rx(s)

BPS103A ;

 ;

 N BPSI

 ;

 S BPINP=$$EDITFLD^BPSSCRCV(1.03,+BPDUZ7,"S^R:RX;A:ALL","Display One or Many (R)x or (A)LL","ALL",.BPARR)

 I BPINP=-1 Q 0

 ;

 S BPSERR=0

 ; 

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

 ;

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

 . S BPS118=$G(BPARR(1.18))

 . I BPS118'="" D

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

 . . I BPSCNT=1 D

 . . . S DIC=52

 . . . S DR=".01;6"

 . . . S DA=BPS118

 . . . S DIQ="BPSRXD"

 . . . S DIQ(0)="E"

 . . . D DIQ^PSODI(52,DIC,DR,DA,.DIQ)   ; ICR 4858

 . . . ; 

 . . . S BPSRXN=$G(BPSRXD(52,DA,.01,"E"))

 . . . S BPSDRUG=$G(BPSRXD(52,DA,6,"E"))

 . . . ; 

 . . . S BPS118AR(BPS118)="",BPS118AR("B",BPSRXN)=BPSDRUG

 . . . ; 

 . . I +BPSCNT>2 D

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

 . . . . S BPS118X=$P(BPS118,";",BPSI)

 . . . . S DIC=52

 . . . . S DR=".01;6"

 . . . . S DA=BPS118X

 . . . . S DIQ="BPSRXD"

 . . . . S DIQ(0)="E"

 . . . . D DIQ^PSODI(52,DIC,DR,DA,.DIQ)   ; ICR 4858

 . . . . ;

 . . . . S BPSRXN=$G(BPSRXD(52,DA,.01,"E"))

 . . . . S BPSDRUG=$G(BPSRXD(52,DA,6,"E"))

 . . . . ; 

 . . . . S BPS118AR(BPS118X)="",BPS118AR("B",BPSRXN)=BPSDRUG

 . ;

 . ; Display existing entry(s) to user.

 . ; 

 . I $D(BPS118AR) D

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

 . . S BPSRXN="" F  S BPSRXN=$O(BPS118AR("B",BPSRXN)) Q:BPSRXN=""  W !,?10,BPSRXN,?30,BPS118AR("B",BPSRXN)

 . ;

 . W !!,"Enter a prescription to select."

 . W !,"Once all prescriptions are selected, hit enter without making a selection.",!

 . ;

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

 . . S PRMTMSG="Select RX"

 . . S DFLTVAL=""

 . . S BPS118=$$PROMPTRX^BPSUTIL1(PRMTMSG,DFLTVAL)

 . . ; 

 . . ; Exit 'Select RX' loop if user entered nil.

 . . ;

 . . I BPS118=-1 Q

 . . ;

 . . S DIC=52

 . . S DR=".01;6"

 . . S DA=BPS118

 . . S DIQ="BPSRXD"

 . . S DIQ(0)="E"

 . . D DIQ^PSODI(52,DIC,DR,DA,.DIQ)   ; ICR 4858

 . . ; 

 . . S BPSRXN=$G(BPSRXD(52,DA,.01,"E"))

 . . S BPSDRUG=$G(BPSRXD(52,DA,6,"E"))

 . .

 . . ; 

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

 . . ; 

 . . I $D(BPS118AR(BPS118)) D

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

 . . . S DIR("A")="Delete "_BPSRXN_" from your list?"

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

 . . . D ^DIR

 . . . I Y="Y" K BPS118AR(BPS118),BPS118AR("B",BPSRXN)

 . . . ; 

 . . E  D

 . . . ; Set new entry into BPS118AR array.

 . . . ; 

 . . . S BPS118AR(BPS118)="",BPS118AR("B",BPSRXN)=BPSDRUG

 . . ;

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

 . . ;

 . . I $D(BPS118AR) D

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

 . . . S BPSRXN="" F  S BPSRXN=$O(BPS118AR("B",BPSRXN)) Q:BPSRXN=""  W !,?10,BPSRXN,?30,BPS118AR("B",BPSRXN)

 . ;

 . ; If user selected (R)x but has not selected any RXs,

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

 . ; 

 . I '$D(BPS118AR) S BPARR(1.03)="A",BPARR(1.18)="" S BPSERR=1 Q

 . ;

 . ; Loop through selected RXs, setting selected RXs into

 . ; BPARR array - delimited by semi-colon.

 . ; 

 . S BPARR(1.18)=";"

 . S BPS118=0 F  S BPS118=$O(BPS118AR(BPS118)) Q:+BPS118=0  S BPARR(1.18)=BPARR(1.18)_BPS118_";"

 E  D  ; User selected ALL

 . S BPARR(1.03)="A"

 . S BPARR(1.18)=""

 ;

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

 ;

 I $G(BPSERR)=1 G BPS103A

 ;

 Q 1

 ;

 ; ^^^^^^^^^^ End of BPS103 / BPS118 Logic ^^^^^^^^^^

 ;

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---BPSSCRV1   13347     printed  Sep 23, 2025@19:29:39                                                                                                                                                                                                   Page 2

BPSSCRV1  ;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       ; 

BPS201(BPARR) ; FIELD 2.01 - Eligibility Type

BPS201A   ;

 +1       ;

 +2        SET BPS201STR=",V,T,C,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)="          V         VETERAN"

 +8        SET DIR("A",5)="          T         TRICARE"

 +9        SET DIR("A",6)="          C         CHAMPVA"

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

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

 +12       SET DIR("A")="Select One or Many Eligibility Types or (A)ll"

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

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

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

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

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

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

 +18       SET DIR("?")="  T,C"

 +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 (BPS201STR) and re-prompt question.

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

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

 +28      ;

 +29       KILL BPS201

 +30       SET X=$TRANSLATE(X,"vtca","VTCA")

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

 +32       SET BPSERR=0

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

               Begin DoDot:1

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

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

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

                       SET BPSERR=1

                       QUIT 

 +36               SET BPS201(BPSSEL)=""

               End DoDot:1

 +37      ; 

 +38       IF $GET(BPSERR)=1

               GOTO BPS201A

 +39      ; 

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

 +41      ;

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

               SET BPARR(2.01)="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(BPS201(BPSSEL))

                       if BPSSEL=""

                           QUIT 

                       Begin DoDot:2

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

 +53                       IF BPSSEL="C"

                               WRITE !,?10,"CHAMPVA"

 +54                       IF BPSSEL="T"

                               WRITE !,?10,"TRICARE"

 +55                       IF BPSSEL="V"

                               WRITE !,?10,"VETERAN"

                       End DoDot:2

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

 +57               SET BPARR(2.01)=BPS201

               End DoDot:1

 +58      ;

 +59       QUIT 1

 +60      ;

 +61      ; ^^^^^^^^^^ End of BPS201 Logic ^^^^^^^^^^

 +62      ;

 +63      ; ********** Start of BPS101 / BPS116 Logic **********

 +64      ;

 +65      ; User input will be temporarily stored in BPS116AR for display to user 

 +66      ; of selected USERS while in CV Action.

 +67      ; 

 +68      ; If U is selected, at least one USER must be selected. If not, selection 

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

 +70      ; 

 +71      ; Upon completion of USERs entry, values will be placed into a string 

 +72      ; delimited by semicolons. e.g. BPARR(1.16)=";12345;56789;"

 +73      ; 

 +74      ; BPS116AR = array containing USER information

 +75      ; BPS116AR(BPS116)=""    BPS116 = IEN from New Person File #200

 +76      ; BPS116AR("B",BPS116NM) BPS116NM = User Name - Index used to display 

 +77      ; selected USERs in alphabetical order while in CV Action.

 +78      ;

BPS101(BPARR) ; Fields 1.01 and 1.16 - User(s)

BPS101A   ;

 +1       ;

 +2        NEW BPSI

 +3       ;

 +4        SET BPINP=$$EDITFLD^BPSSCRCV(1.01,+BPDUZ7,"S^U:USER;A:ALL","Display One or Many ECME (U)sers or (A)LL","ALL",.BPARR)

 +5        IF BPINP=-1

               QUIT 0

 +6       ;

 +7        SET BPSERR=0

 +8       ;

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

 +10      ;

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

               Begin DoDot:1

 +12               SET BPS116=$GET(BPARR(1.16))

 +13               IF BPS116'=""

                       Begin DoDot:2

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

 +15                       IF BPSCNT=1

                               Begin DoDot:3

 +16                               SET BPS116NM=$$GET1^DIQ(200,BPS116,.01)

 +17                               IF $GET(BPS116NM)'=""

                                       SET BPS116AR(BPS116)=""

                                       SET BPS116AR("B",BPS116NM)=""

                               End DoDot:3

 +18                       IF +BPSCNT>2

                               Begin DoDot:3

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

                                       Begin DoDot:4

 +20                                       SET BPS116X=$PIECE(BPS116,";",BPSI)

                                           SET BPS116NM=$$GET1^DIQ(200,BPS116X,.01)

 +21                                       IF $GET(BPS116NM)'=""

                                               SET BPS116AR(BPS116X)=""

                                               SET BPS116AR("B",BPS116NM)=""

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

 +22      ;

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

 +24      ;

 +25               IF $DATA(BPS116AR)

                       Begin DoDot:2

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

 +27                       SET BPS116NM=""

                           FOR 

                               SET BPS116NM=$ORDER(BPS116AR("B",BPS116NM))

                               if BPS116NM=""

                                   QUIT 

                               WRITE !,?10,BPS116NM

                       End DoDot:2

 +28      ;

 +29               WRITE !!,"Enter a user to select."

 +30               WRITE !,"Once all users are selected, hit enter without making a selection.",!

 +31      ;

 +32               SET BPS116=""

                   FOR 

                       Begin DoDot:2

 +33                       SET DIR0="P^VA(200,"

 +34                       SET PRMTMSG="Select User"

 +35                       SET DFLTVAL=""

 +36                       SET BPS116=$$PROMPT^BPSSCRCV(DIR0,PRMTMSG,DFLTVAL)

 +37      ;

 +38      ; Exit 'Select User' loop if user entered nil.

 +39      ; 

 +40                       IF BPS116=-1

                               QUIT 

 +41      ; 

 +42                       SET BPS116NM=$$GET1^DIQ(200,BPS116,.01)

 +43      ;

 +44      ; If entry exists in BPS116AR array, prompt user to delete from list.

 +45      ; 

 +46                       IF $DATA(BPS116AR(BPS116))

                               Begin DoDot:3

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

 +48                               SET DIR("A")="Delete "_BPS116NM_" from your list?"

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

 +50                               DO ^DIR

 +51                               IF Y="Y"

                                       KILL BPS116AR(BPS116),BPS116AR("B",BPS116NM)

 +52      ; 

                               End DoDot:3

 +53                      IF '$TEST

                               Begin DoDot:3

 +54      ; 

 +55      ; Set new entry into BPS116AR array.

 +56      ;

 +57                               IF $GET(BPS116NM)'=""

                                       SET BPS116AR(BPS116)=""

                                       SET BPS116AR("B",BPS116NM)=""

                               End DoDot:3

 +58      ;

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

 +60      ;

 +61                       IF $DATA(BPS116AR)

                               Begin DoDot:3

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

 +63                               SET BPS116NM=""

                                   FOR 

                                       SET BPS116NM=$ORDER(BPS116AR("B",BPS116NM))

                                       if BPS116NM=""

                                           QUIT 

                                       WRITE !,?10,BPS116NM

                               End DoDot:3

                       End DoDot:2

                       if BPS116=-1

                           QUIT 

 +64      ;

 +65      ; If user selected (U)ser but has not selected any users,

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

 +67      ; 

 +68               IF '$DATA(BPS116AR)

                       SET BPARR(1.01)="A"

                       SET BPARR(1.16)=""

                       SET BPSERR=1

                       QUIT 

 +69      ;

 +70      ; Loop through selected users, setting selected users into 

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

 +72      ; 

 +73               SET BPARR(1.16)=";"

 +74               SET BPS116=0

                   FOR 

                       SET BPS116=$ORDER(BPS116AR(BPS116))

                       if +BPS116=0

                           QUIT 

                       SET BPARR(1.16)=BPARR(1.16)_BPS116_";"

               End DoDot:1

 +75      ; User selected ALL

          IF '$TEST

               Begin DoDot:1

 +76               SET BPARR(1.01)="A"

 +77               SET BPARR(1.16)=""

               End DoDot:1

 +78      ;

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

 +80      ; 

 +81       IF $GET(BPSERR)=1

               GOTO BPS101A

 +82      ;

 +83       QUIT 1

 +84      ;

 +85      ; ^^^^^^^^^^ End of BPS101 / BPS116 Logic ^^^^^^^^^^

 +86      ;

 +87      ; ********** Start of BPS102 / BPS117 Logic **********

 +88      ;

 +89      ; User input will be temporarily stored in BPS117AR for display to user 

 +90      ; of selected PATIENTS while in CV Action.

 +91      ; 

 +92      ; If P is selected, at least one PATIENT must be selected. If not, selection 

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

 +94      ; 

 +95      ; Upon completion of PATIENTs entry, values will be placed into a string 

 +96      ; delimited by semicolons. e.g. BPARR(1.17)=";12345;56789;"

 +97      ; 

 +98      ; BPS117AR = array containing PATIENT information

 +99      ; BPS117AR(BPS117)=""    BPS117 = IEN from Patient File ^DPT

 +100     ; BPS117AR("B",BPS117M) BPS117NM = Patient Name - Index used to display 

 +101     ; selected PATIENTs in alphabetical order while in CV Action. 

 +102     ;

BPS102(BPARR) ; Fields 1.02 and 1.17 - Patient(s)

BPS102A   ;

 +1       ;

 +2        NEW BPSI

 +3       ;

 +4        SET BPINP=$$EDITFLD^BPSSCRCV(1.02,+BPDUZ7,"S^P:PATIENT;A:ALL","Display One or Many (P)atients or (A)LL","ALL",.BPARR)

 +5        IF BPINP=-1

               QUIT 0

 +6       ;

 +7        SET BPSERR=0

 +8       ;

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

 +10      ;

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

               Begin DoDot:1

 +12               SET BPS117=$GET(BPARR(1.17))

 +13               IF BPS117'=""

                       Begin DoDot:2

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

 +15                       IF BPSCNT=1

                               Begin DoDot:3

 +16                               SET BPS117NM=$$GET1^DIQ(2,BPS117,.01)

 +17                               IF $GET(BPS117NM)'=""

                                       SET BPS117AR(BPS117)=""

                                       SET BPS117AR("B",BPS117NM)=""

                               End DoDot:3

 +18                       IF +BPSCNT>2

                               Begin DoDot:3

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

                                       Begin DoDot:4

 +20                                       SET BPS117X=$PIECE(BPS117,";",BPSI)

                                           SET BPS117NM=$$GET1^DIQ(2,BPS117X,.01)

 +21                                       IF $GET(BPS117NM)'=""

                                               SET BPS117AR(BPS117X)=""

                                               SET BPS117AR("B",BPS117NM)=""

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

 +22      ;

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

 +24      ; 

 +25               IF $DATA(BPS117AR)

                       Begin DoDot:2

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

 +27                       SET BPS117NM=""

                           FOR 

                               SET BPS117NM=$ORDER(BPS117AR("B",BPS117NM))

                               if BPS117NM=""

                                   QUIT 

                               WRITE !,?10,BPS117NM

                       End DoDot:2

 +28      ;

 +29               WRITE !!,"Enter a patient to select."

 +30               WRITE !,"Once all patients are selected, hit enter without making a selection.",!

 +31      ;

 +32               SET BPS117=""

                   FOR 

                       Begin DoDot:2

 +33                       SET DIR0="P^DPT("

 +34                       SET PRMTMSG="Select Patient"

 +35                       SET DFLTVAL=""

 +36                       SET BPS117=$$PROMPT^BPSSCRCV(DIR0,PRMTMSG,DFLTVAL)

 +37      ;

 +38      ; Exit 'Select Patient' loop if user entered nil.

 +39      ; 

 +40                       IF BPS117=-1

                               QUIT 

 +41      ; 

 +42                       SET BPS117NM=$$GET1^DIQ(2,BPS117,.01)

 +43      ;

 +44      ; If entry exists in BPS117AR array, prompt user to delete from list.

 +45      ; 

 +46                       IF $DATA(BPS117AR(BPS117))

                               Begin DoDot:3

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

 +48                               SET DIR("A")="Delete "_BPS117NM_" from your list?"

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

 +50                               DO ^DIR

 +51                               IF Y="Y"

                                       KILL BPS117AR(BPS117),BPS117AR("B",BPS117NM)

 +52      ; 

                               End DoDot:3

 +53                      IF '$TEST

                               Begin DoDot:3

 +54      ; 

 +55      ; Set new entry into BPS117AR array.

 +56      ; 

 +57                               IF $GET(BPS117NM)'=""

                                       SET BPS117AR(BPS117)=""

                                       SET BPS117AR("B",BPS117NM)=""

                               End DoDot:3

 +58      ;

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

 +60      ; 

 +61                       IF $DATA(BPS117AR)

                               Begin DoDot:3

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

 +63                               SET BPS117NM=""

                                   FOR 

                                       SET BPS117NM=$ORDER(BPS117AR("B",BPS117NM))

                                       if BPS117NM=""

                                           QUIT 

                                       WRITE !,?10,BPS117NM

                               End DoDot:3

                       End DoDot:2

                       if BPS117=-1

                           QUIT 

 +64      ;

 +65      ; If user selected (P)atient but has not selected any patients,

 +66      ; set profile setting to ALL and re-prompt question.

 +67      ; 

 +68               IF '$DATA(BPS117AR)

                       SET BPARR(1.02)="A"

                       SET BPARR(1.17)=""

                       SET BPSERR=1

                       QUIT 

 +69      ;

 +70      ; Loop through selected patients, setting selected patients into

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

 +72      ;

 +73               SET BPARR(1.17)=";"

 +74               SET BPS117=0

                   FOR 

                       SET BPS117=$ORDER(BPS117AR(BPS117))

                       if +BPS117=0

                           QUIT 

                       SET BPARR(1.17)=BPARR(1.17)_BPS117_";"

               End DoDot:1

 +75      ; User selected ALL

          IF '$TEST

               Begin DoDot:1

 +76               SET BPARR(1.02)="A"

 +77               SET BPARR(1.17)=""

               End DoDot:1

 +78      ;

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

 +80      ; 

 +81       IF $GET(BPSERR)=1

               GOTO BPS102A

 +82      ;

 +83       QUIT 1

 +84      ;

 +85      ; ^^^^^^^^^^ End of BPS102 / BPS117 Logic ^^^^^^^^^^

 +86      ;

 +87      ; ********** Start of BPS103 / BPS118 Logic **********

 +88      ;

 +89      ; User input will be temporarily stored in BPS118AR for display to user 

 +90      ; of selected RXs while in CV Action.

 +91      ; 

 +92      ; If R is selected, at least one RX must be selected. If not, selection 

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

 +94      ; 

 +95      ; Upon completion of RXs entry, values will be placed into a string 

 +96      ; delimited by semicolons. e.g. BPARR(1.18)=";12345;56789;"

 +97      ; 

 +98      ; BPS118AR = array containing RX information

 +99      ; BPS118AR(BPS118)=""  BPS118 = IEN from Prescription File #52

 +100     ; BPS118AR("B",BPSRXN) BPSRXN = RX Number - Index used to display 

 +101     ; selected RXs in numerical order while in CV Action.

 +102     ;   

BPS103(BPARR) ; Fields 1.03 and 1.18 - Rx(s)

BPS103A   ;

 +1       ;

 +2        NEW BPSI

 +3       ;

 +4        SET BPINP=$$EDITFLD^BPSSCRCV(1.03,+BPDUZ7,"S^R:RX;A:ALL","Display One or Many (R)x 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 BPS118AR array.

 +10      ;

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

               Begin DoDot:1

 +12               SET BPS118=$GET(BPARR(1.18))

 +13               IF BPS118'=""

                       Begin DoDot:2

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

 +15                       IF BPSCNT=1

                               Begin DoDot:3

 +16                               SET DIC=52

 +17                               SET DR=".01;6"

 +18                               SET DA=BPS118

 +19                               SET DIQ="BPSRXD"

 +20                               SET DIQ(0)="E"

 +21      ; ICR 4858

                                   DO DIQ^PSODI(52,DIC,DR,DA,.DIQ)

 +22      ; 

 +23                               SET BPSRXN=$GET(BPSRXD(52,DA,.01,"E"))

 +24                               SET BPSDRUG=$GET(BPSRXD(52,DA,6,"E"))

 +25      ; 

 +26                               SET BPS118AR(BPS118)=""

                                   SET BPS118AR("B",BPSRXN)=BPSDRUG

 +27      ; 

                               End DoDot:3

 +28                       IF +BPSCNT>2

                               Begin DoDot:3

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

                                       Begin DoDot:4

 +30                                       SET BPS118X=$PIECE(BPS118,";",BPSI)

 +31                                       SET DIC=52

 +32                                       SET DR=".01;6"

 +33                                       SET DA=BPS118X

 +34                                       SET DIQ="BPSRXD"

 +35                                       SET DIQ(0)="E"

 +36      ; ICR 4858

                                           DO DIQ^PSODI(52,DIC,DR,DA,.DIQ)

 +37      ;

 +38                                       SET BPSRXN=$GET(BPSRXD(52,DA,.01,"E"))

 +39                                       SET BPSDRUG=$GET(BPSRXD(52,DA,6,"E"))

 +40      ; 

 +41                                       SET BPS118AR(BPS118X)=""

                                           SET BPS118AR("B",BPSRXN)=BPSDRUG

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

 +42      ;

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

 +44      ; 

 +45               IF $DATA(BPS118AR)

                       Begin DoDot:2

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

 +47                       SET BPSRXN=""

                           FOR 

                               SET BPSRXN=$ORDER(BPS118AR("B",BPSRXN))

                               if BPSRXN=""

                                   QUIT 

                               WRITE !,?10,BPSRXN,?30,BPS118AR("B",BPSRXN)

                       End DoDot:2

 +48      ;

 +49               WRITE !!,"Enter a prescription to select."

 +50               WRITE !,"Once all prescriptions are selected, hit enter without making a selection.",!

 +51      ;

 +52               SET BPS118=""

                   FOR 

                       Begin DoDot:2

 +53                       SET PRMTMSG="Select RX"

 +54                       SET DFLTVAL=""

 +55                       SET BPS118=$$PROMPTRX^BPSUTIL1(PRMTMSG,DFLTVAL)

 +56      ; 

 +57      ; Exit 'Select RX' loop if user entered nil.

 +58      ;

 +59                       IF BPS118=-1

                               QUIT 

 +60      ;

 +61                       SET DIC=52

 +62                       SET DR=".01;6"

 +63                       SET DA=BPS118

 +64                       SET DIQ="BPSRXD"

 +65                       SET DIQ(0)="E"

 +66      ; ICR 4858

                           DO DIQ^PSODI(52,DIC,DR,DA,.DIQ)

 +67      ; 

 +68                       SET BPSRXN=$GET(BPSRXD(52,DA,.01,"E"))

 +69                       SET BPSDRUG=$GET(BPSRXD(52,DA,6,"E"))

 +70  +71 ; 

 +72      ; If entry exists in BPS118AR array, prompt user to delete from list.

 +73      ; 

 +74                       IF $DATA(BPS118AR(BPS118))

                               Begin DoDot:3

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

 +76                               SET DIR("A")="Delete "_BPSRXN_" from your list?"

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

 +78                               DO ^DIR

 +79                               IF Y="Y"

                                       KILL BPS118AR(BPS118),BPS118AR("B",BPSRXN)

 +80      ; 

                               End DoDot:3

 +81                      IF '$TEST

                               Begin DoDot:3

 +82      ; Set new entry into BPS118AR array.

 +83      ; 

 +84                               SET BPS118AR(BPS118)=""

                                   SET BPS118AR("B",BPSRXN)=BPSDRUG

                               End DoDot:3

 +85      ;

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

 +87      ;

 +88                       IF $DATA(BPS118AR)

                               Begin DoDot:3

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

 +90                               SET BPSRXN=""

                                   FOR 

                                       SET BPSRXN=$ORDER(BPS118AR("B",BPSRXN))

                                       if BPSRXN=""

                                           QUIT 

                                       WRITE !,?10,BPSRXN,?30,BPS118AR("B",BPSRXN)

                               End DoDot:3

                       End DoDot:2

                       if BPS118=-1

                           QUIT 

 +91      ;

 +92      ; If user selected (R)x but has not selected any RXs,

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

 +94      ; 

 +95               IF '$DATA(BPS118AR)

                       SET BPARR(1.03)="A"

                       SET BPARR(1.18)=""

                       SET BPSERR=1

                       QUIT 

 +96      ;

 +97      ; Loop through selected RXs, setting selected RXs into

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

 +99      ; 

 +100              SET BPARR(1.18)=";"

 +101              SET BPS118=0

                   FOR 

                       SET BPS118=$ORDER(BPS118AR(BPS118))

                       if +BPS118=0

                           QUIT 

                       SET BPARR(1.18)=BPARR(1.18)_BPS118_";"

               End DoDot:1

 +102     ; User selected ALL

          IF '$TEST

               Begin DoDot:1

 +103              SET BPARR(1.03)="A"

 +104              SET BPARR(1.18)=""

               End DoDot:1

 +105     ;

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

 +107     ;

 +108      IF $GET(BPSERR)=1

               GOTO BPS103A

 +109     ;

 +110      QUIT 1

 +111     ;

 +112     ; ^^^^^^^^^^ End of BPS103 / BPS118 Logic ^^^^^^^^^^

 +113     ;

 +114      QUIT