IBCOMD ;ALB/CMS - GENERATE INSURANCE COMPANY LISTINGS ;03-AUG-98
;;2.0;INTEGRATED BILLING;**103,528,732,743**;21-MAR-94;Build 18
;;Per VA Directive 6402, this routine should not be modified.
;
; Reference to D EN^XUTMDEVQ in ICR #1519
Q
EN ; Entry point from option
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
;IB*732/CKB - added IBDEF and STOP
N IBAIB,IBCASE,IBDEF,IBF,IBFLD,IBOUT,IBQ,IBQUIT,IBTY,STOP,X,Y
S STOP=0
W !!,?10,"Generate Insurance Company Listings",!
S DIR("A",1)="Sort report by"
S DIR("A",2)="1 - Active Insurance Companies"
S DIR("A",3)="2 - Inactive Insurance Companies"
S DIR("A",4)="3 - Both"
S DIR("A",5)=" "
;IB*732/CKB - allow selection to be case insensitive. If user enters
; '^', set STOP=1 to exit
;S DIR(0)="SAXB^1:Active;2:Inactive;3:Both"
S DIR(0)="SA^1:Active;2:Inactive;3:Both"
S DIR("A")=" Select Number: "
S DIR("B")="1"
S DIR("??")="^D ENH^IBCOMD"
D ^DIR
I $D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!(+Y'>0) S STOP=1
I Y="^" S STOP=1
K DIR,DIROUT,DIRUT,DTOUT,DUOUT
I STOP G EXIT
S IBAIB=+Y
;
W !!,"You may search for specific companies to be included in this report by"
W !,"'screening' companies based on the company name, street, city, or state."
W !,"You may select any combination of these fields and specify a 'range' of"
W !,"values that the field must fall between, or a specific value that the"
W !,"field must 'contain.'",!
;
K IBFLD
S STOP=0
S IBFLD(1)="NAME",IBFLD(2)="STREET",IBFLD(3)="CITY",IBFLD(4)="STATE"
K IBCASE S IBQ=0 F D Q:(IBQ)!(STOP=1) W !
.;
.; - ask for the field
.S DIR("A",1)=" Select a"_$S($D(IBCASE):"nother",1:"")_" field to screen Insurance Companies"
.S DIR("A",2)=" "
.S DIR("A",3)=" 1 - NAME"
.S DIR("A",4)=" 2 - STREET"
.S DIR("A",5)=" 3 - CITY"
.S DIR("A",6)=" 4 - STATE"
.S DIR("A",7)=" "
.;IB*732/CKB - allow selection to be case insensitive. If user enters
.; '^', set STOP=1 to exit
.;S DIR(0)="SAOXB^1:NAME;2:STREET;3:CITY;4:STATE"
.S DIR(0)="SAO^1:NAME;2:STREET;3:CITY;4:STATE"
.S DIR("A")=" Select a field by Number: "
.S DIR("??")="^D FLD^IBCOMD"
.D ^DIR
.I $D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!(+Y'>0) S IBQ=1
.I Y="^" S STOP=1
.K DIR,DIROUT,DIRUT,DTOUT,DUOUT
.I IBQ Q
.S IBF=+Y
.;
.; - if state was chosen, select a state and quit
.I IBF=4 D Q
..S DIC="^DIC(5,",DIC(0)="QEAMZ",DIC("A")="Select STATE: "
..I $P($G(IBCASE(4)),"^",2) S DIC("B")=$P($G(^DIC(5,$P($G(IBCASE(4)),"^",2),0)),"^")
..;IB*732/CKB - if user enters '^', set STOP to exit
..D ^DIC K DIC
..I X="^" S STOP=1
..I (Y'>0)!(STOP=1) K IBCASE(4) Q
..S IBCASE(4)="^"_+Y
.;
.; - ask user to select values by 'range' or 'contains'
.S DIR("A")="Allow a (R)ange of values or a value that (C)ontains a specific string: "
.;IB*732/CKB - allow selection to case insensitive, properly display previous value
.; and if user enters '^' set STOP to exit
.;S DIR(0)="SAXB^R:RANGE;C:CONTAINS",DIR("??")="^D RAN^IBCOMD"
.S DIR(0)="SA^R:RANGE;C:CONTAINS"
.S DIR("?")="This response can be free text."
.S DIR("??")="^D RAN^IBCOMD"
.I $P($G(IBCASE(IBF)),"^")'="" S DIR("B")=$P($G(IBCASE(IBF)),"^")
.D ^DIR
.I $D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!(Y="^") S STOP=1
.K DIR,DIROUT,DTOUT,DUOUT,DIRUT
.I Y'="R",Y'="C"!(STOP) K IBCASE(IBF) Q
.S IBTY=Y
.;
.; - ask user to select value that 'contains'
.;IB*732/CKB - allow selection to case insensitive and properly display previous
.;value. If user enters '^' set STOP to exit
.I IBTY="C" D Q
..S IBDEF=$P($G(IBCASE(IBF)),"^",2)
..S DIR(0)="FAO"
..S DIR("A")=IBFLD(IBF)_" contains the value: "
..I $P($G(IBCASE(IBF)),"^",2)'="" S DIR("B")=$P($G(IBCASE(IBF)),"^",2)
..S DIR("?")="This response can be free text."
..S DIR("??")="^D CON^IBCOMD"
..D ^DIR K DIR
..I Y="^" S STOP=1
..I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)!(STOP) K IBCASE(IBF),DIROUT,DTOUT,DUOUT,DIRUT Q
..I Y="" W !!,?5,"Note: Companies will be selected where ",IBFLD(IBF)," is null."
..S IBCASE(IBF)=IBTY_"^"_Y
.;
.; - ask user to select a range of values
.D SELR
;
;IB*732/CKB - user entered '^', go to exit and quit
I (Y="^")!(STOP=1) G EXIT
;
I '$D(IBCASE) W !!,"Please note that no screening fields were selected!",!
;IB*732/CKB - call DISPLAY tag to display the selected screening fields
I $D(IBCASE) D DISPLAY W !
;E D W !
;.N I,H
;.W !!,"The following conditions were selected:"
;.S (H,I)=0 F S I=$O(IBCASE(I)) Q:'I D
;..W ! I H W ?3,"and"
;..S H=1 W ?8,IBFLD(I)
;..W ?18,$S(I=4:"Equals ",$P(IBCASE(I),"^")="C":"Contains ",1:"Between ")
;..W $S(I=4:$P($G(^DIC(5,+$P(IBCASE(I),"^",2),0)),"^"),$P(IBCASE(I),"^",2)="":"'FIRST'",1:$P(IBCASE(I),"^",2))
;..I $P(IBCASE(I),"^")="R" W " and ",$S($P(IBCASE(I),"^",3)="zzzzzz":"'LAST'",1:$P(IBCASE(I),"^",3))
;
S IBOUT=$$OUT G:IBOUT="" EXIT
;
D QUE
;
EXIT ;
Q
;
;
SELR ; Select a range of values
;IB*732/CKB - made code easier to read and if user enters '^', set STOP to exit
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,IBRF,IBRL,X,Y
SELRR ;
;IB*743/TAZ - Updated code to accept NULL to mean beginning of list.
W !!,"Enter Start With value or Press <ENTER> to start at the beginning of the list.",!
S DIR(0)="FO"
S DIR("A")="START WITH '"_IBFLD(IBF)_"' VALUE"
I $P($G(IBCASE(IBF)),"^",2)'="" S DIR("B")=$P($G(IBCASE(IBF)),"^",2)
S DIR("?")="^D RANGE^IBCOMD(""BEGIN"")"
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(Y="^") S STOP=1 K IBCASE(IBF) Q
S IBRF=Y
;
;IB*743/TAZ - Updated code to accept NULL to mean end of list.
W !!,"Enter Go To value or Press <ENTER> to finish at the end of the list.",!
S DIR(0)="FO"
S DIR("A")="GO TO '"_IBFLD(IBF)_"' VALUE"
; IB*743/DTG do not dispay 'zzzzzz' on edit
I ($P($G(IBCASE(IBF)),"^",3)'="")&($P($G(IBCASE(IBF)),"^",3)'="zzzzzz") S DIR("B")=$P($G(IBCASE(IBF)),"^",3)
S DIR("?")="^D RANGE^IBCOMD(""END"")"
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(Y="^") S STOP=1 K IBCASE(IBF) Q
S IBRL=$S(Y="":"zzzzzz",1:Y)
;
; - the 'go to' value must follow the 'start with' value
;IB*732/CKB - make selection case insensitive
I $$UP^XLFSTR($G(IBRL))']$$UP^XLFSTR($G(IBRF)) D G SELRR
. W !!,?5,">>>>> The 'Go To' value must follow after the 'Start With' value. <<<<<",!
S IBCASE(IBF)="R^"_IBRF_"^"_IBRL
Q
;
DISPLAY ;IB*732/CKB - Display the selected screening conditions
N I,H
W !!,"The following conditions were selected:"
S (H,I)=0 F S I=$O(IBCASE(I)) Q:'I D
.W ! I H W ?3,"and"
.S H=1 W ?8,IBFLD(I)
.W ?18,$S(I=4:"Equals ",$P(IBCASE(I),"^")="C":"Contains ",1:"Between ")
.W $S(I=4:$P($G(^DIC(5,+$P(IBCASE(I),"^",2),0)),"^"),$P(IBCASE(I),"^",2)="":"'FIRST'",1:$P(IBCASE(I),"^",2))
.I $P(IBCASE(I),"^")="R" W " and ",$S($P(IBCASE(I),"^",3)="zzzzzz":"'LAST'",1:$P(IBCASE(I),"^",3))
Q
;
ENH ; Active, Inactive or Both help Text
W !!,?5,"Enter 1 to search Active Insurance Companies"
W !,?5,"Enter 2 to search Inactive Insurance Companies"
W !,?5,"Enter 3 to include Active and Inactive Insurance Companies in Report",!
Q
;
FLD ;Field selection help text
W !!,?5,"Enter 1 to screen insurance company by Name"
W !,?5,"Enter 2 to screen insurance company by Street"
W !,?5,"Enter 3 to screen insurance company by City"
W !,?5,"Enter 4 to screen insurance company by State"
Q
;
RAN ; Help for the Range/Contains prompt.
W !!,?5,"Enter 'R' to enter a 'Start From' and 'Go To' range, or 'C' to enter"
W !,?5,"a specific string that the field value must contain. Enter '^' to"
W !,?5,"eliminate this screen field and select another field."
Q
;
CON ; Help for the 'Contains' prompt.
W !!,?5,"Enter a string that the field value should contain. Enter a <CR> to"
W !,?5,"find entries where the field value is null. Enter '^' to eliminate"
W !,?5,"this screen field and select another field."
Q
;
;IB*743/TAZ - Help for the Range Prompt
RANGE(LEVEL) ; ?? Help for the Range Prompt
W !!,?5,"Enter a value the entries in the list should ",LEVEL," with."
I LEVEL="BEGIN" W !,?5,"Press <ENTER> to start at the beginning of the list."
I LEVEL="END" W !,?5,"Press <ENTER> to finish at the end of the list."
Q
;
QUE ; Ask Device
;IB*732/CKB - Modified to allow Queuing of the report, and added Excel
; warning to prevent wrapping
N ZTDESC,ZTRTN,ZTSAVE
;
I IBOUT="E" D
. W !!,"For CSV output, turn logging or capture on now. To avoid undesired wrapping"
. W !,"of the data saved to the file, please enter ""0;256;99999"" at the ""DEVICE:"""
. W !,"prompt.",!
;
S ZTRTN="BEG^IBCOMD1"
S ZTSAVE("IBAIB")="",ZTSAVE("IBFLD(")="",ZTSAVE("IBOUT")=""
I $D(IBCASE) S ZTSAVE("IBCASE(")=""
S ZTDESC="IB - Identify Dup Insurance Companies"
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"Q") ; ICR #1519
QUEQ ;
Q
;
OUT() ;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="SA^E:Excel;R:Report"
S DIR("A")="(E)xcel Format or (R)eport Format: "
S DIR("B")="Report"
D ^DIR I $D(DIRUT) Q ""
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCOMD 9052 printed Jan 18, 2025@03:19:33 Page 2
IBCOMD ;ALB/CMS - GENERATE INSURANCE COMPANY LISTINGS ;03-AUG-98
+1 ;;2.0;INTEGRATED BILLING;**103,528,732,743**;21-MAR-94;Build 18
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference to D EN^XUTMDEVQ in ICR #1519
+5 QUIT
EN ; Entry point from option
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+2 ;IB*732/CKB - added IBDEF and STOP
+3 NEW IBAIB,IBCASE,IBDEF,IBF,IBFLD,IBOUT,IBQ,IBQUIT,IBTY,STOP,X,Y
+4 SET STOP=0
+5 WRITE !!,?10,"Generate Insurance Company Listings",!
+6 SET DIR("A",1)="Sort report by"
+7 SET DIR("A",2)="1 - Active Insurance Companies"
+8 SET DIR("A",3)="2 - Inactive Insurance Companies"
+9 SET DIR("A",4)="3 - Both"
+10 SET DIR("A",5)=" "
+11 ;IB*732/CKB - allow selection to be case insensitive. If user enters
+12 ; '^', set STOP=1 to exit
+13 ;S DIR(0)="SAXB^1:Active;2:Inactive;3:Both"
+14 SET DIR(0)="SA^1:Active;2:Inactive;3:Both"
+15 SET DIR("A")=" Select Number: "
+16 SET DIR("B")="1"
+17 SET DIR("??")="^D ENH^IBCOMD"
+18 DO ^DIR
+19 IF $DATA(DIROUT)!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!(+Y'>0)
SET STOP=1
+20 IF Y="^"
SET STOP=1
+21 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
+22 IF STOP
GOTO EXIT
+23 SET IBAIB=+Y
+24 ;
+25 WRITE !!,"You may search for specific companies to be included in this report by"
+26 WRITE !,"'screening' companies based on the company name, street, city, or state."
+27 WRITE !,"You may select any combination of these fields and specify a 'range' of"
+28 WRITE !,"values that the field must fall between, or a specific value that the"
+29 WRITE !,"field must 'contain.'",!
+30 ;
+31 KILL IBFLD
+32 SET STOP=0
+33 SET IBFLD(1)="NAME"
SET IBFLD(2)="STREET"
SET IBFLD(3)="CITY"
SET IBFLD(4)="STATE"
+34 KILL IBCASE
SET IBQ=0
FOR
Begin DoDot:1
+35 ;
+36 ; - ask for the field
+37 SET DIR("A",1)=" Select a"_$SELECT($DATA(IBCASE):"nother",1:"")_" field to screen Insurance Companies"
+38 SET DIR("A",2)=" "
+39 SET DIR("A",3)=" 1 - NAME"
+40 SET DIR("A",4)=" 2 - STREET"
+41 SET DIR("A",5)=" 3 - CITY"
+42 SET DIR("A",6)=" 4 - STATE"
+43 SET DIR("A",7)=" "
+44 ;IB*732/CKB - allow selection to be case insensitive. If user enters
+45 ; '^', set STOP=1 to exit
+46 ;S DIR(0)="SAOXB^1:NAME;2:STREET;3:CITY;4:STATE"
+47 SET DIR(0)="SAO^1:NAME;2:STREET;3:CITY;4:STATE"
+48 SET DIR("A")=" Select a field by Number: "
+49 SET DIR("??")="^D FLD^IBCOMD"
+50 DO ^DIR
+51 IF $DATA(DIROUT)!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!(+Y'>0)
SET IBQ=1
+52 IF Y="^"
SET STOP=1
+53 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
+54 IF IBQ
QUIT
+55 SET IBF=+Y
+56 ;
+57 ; - if state was chosen, select a state and quit
+58 IF IBF=4
Begin DoDot:2
+59 SET DIC="^DIC(5,"
SET DIC(0)="QEAMZ"
SET DIC("A")="Select STATE: "
+60 IF $PIECE($GET(IBCASE(4)),"^",2)
SET DIC("B")=$PIECE($GET(^DIC(5,$PIECE($GET(IBCASE(4)),"^",2),0)),"^")
+61 ;IB*732/CKB - if user enters '^', set STOP to exit
+62 DO ^DIC
KILL DIC
+63 IF X="^"
SET STOP=1
+64 IF (Y'>0)!(STOP=1)
KILL IBCASE(4)
QUIT
+65 SET IBCASE(4)="^"_+Y
End DoDot:2
QUIT
+66 ;
+67 ; - ask user to select values by 'range' or 'contains'
+68 SET DIR("A")="Allow a (R)ange of values or a value that (C)ontains a specific string: "
+69 ;IB*732/CKB - allow selection to case insensitive, properly display previous value
+70 ; and if user enters '^' set STOP to exit
+71 ;S DIR(0)="SAXB^R:RANGE;C:CONTAINS",DIR("??")="^D RAN^IBCOMD"
+72 SET DIR(0)="SA^R:RANGE;C:CONTAINS"
+73 SET DIR("?")="This response can be free text."
+74 SET DIR("??")="^D RAN^IBCOMD"
+75 IF $PIECE($GET(IBCASE(IBF)),"^")'=""
SET DIR("B")=$PIECE($GET(IBCASE(IBF)),"^")
+76 DO ^DIR
+77 IF $DATA(DIROUT)!$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!(Y="^")
SET STOP=1
+78 KILL DIR,DIROUT,DTOUT,DUOUT,DIRUT
+79 IF Y'="R"
IF Y'="C"!(STOP)
KILL IBCASE(IBF)
QUIT
+80 SET IBTY=Y
+81 ;
+82 ; - ask user to select value that 'contains'
+83 ;IB*732/CKB - allow selection to case insensitive and properly display previous
+84 ;value. If user enters '^' set STOP to exit
+85 IF IBTY="C"
Begin DoDot:2
+86 SET IBDEF=$PIECE($GET(IBCASE(IBF)),"^",2)
+87 SET DIR(0)="FAO"
+88 SET DIR("A")=IBFLD(IBF)_" contains the value: "
+89 IF $PIECE($GET(IBCASE(IBF)),"^",2)'=""
SET DIR("B")=$PIECE($GET(IBCASE(IBF)),"^",2)
+90 SET DIR("?")="This response can be free text."
+91 SET DIR("??")="^D CON^IBCOMD"
+92 DO ^DIR
KILL DIR
+93 IF Y="^"
SET STOP=1
+94 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)!(STOP)
KILL IBCASE(IBF),DIROUT,DTOUT,DUOUT,DIRUT
QUIT
+95 IF Y=""
WRITE !!,?5,"Note: Companies will be selected where ",IBFLD(IBF)," is null."
+96 SET IBCASE(IBF)=IBTY_"^"_Y
End DoDot:2
QUIT
+97 ;
+98 ; - ask user to select a range of values
+99 DO SELR
End DoDot:1
if (IBQ)!(STOP=1)
QUIT
WRITE !
+100 ;
+101 ;IB*732/CKB - user entered '^', go to exit and quit
+102 IF (Y="^")!(STOP=1)
GOTO EXIT
+103 ;
+104 IF '$DATA(IBCASE)
WRITE !!,"Please note that no screening fields were selected!",!
+105 ;IB*732/CKB - call DISPLAY tag to display the selected screening fields
+106 IF $DATA(IBCASE)
DO DISPLAY
WRITE !
+107 ;E D W !
+108 ;.N I,H
+109 ;.W !!,"The following conditions were selected:"
+110 ;.S (H,I)=0 F S I=$O(IBCASE(I)) Q:'I D
+111 ;..W ! I H W ?3,"and"
+112 ;..S H=1 W ?8,IBFLD(I)
+113 ;..W ?18,$S(I=4:"Equals ",$P(IBCASE(I),"^")="C":"Contains ",1:"Between ")
+114 ;..W $S(I=4:$P($G(^DIC(5,+$P(IBCASE(I),"^",2),0)),"^"),$P(IBCASE(I),"^",2)="":"'FIRST'",1:$P(IBCASE(I),"^",2))
+115 ;..I $P(IBCASE(I),"^")="R" W " and ",$S($P(IBCASE(I),"^",3)="zzzzzz":"'LAST'",1:$P(IBCASE(I),"^",3))
+116 ;
+117 SET IBOUT=$$OUT
if IBOUT=""
GOTO EXIT
+118 ;
+119 DO QUE
+120 ;
EXIT ;
+1 QUIT
+2 ;
+3 ;
SELR ; Select a range of values
+1 ;IB*732/CKB - made code easier to read and if user enters '^', set STOP to exit
+2 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,IBRF,IBRL,X,Y
SELRR ;
+1 ;IB*743/TAZ - Updated code to accept NULL to mean beginning of list.
+2 WRITE !!,"Enter Start With value or Press <ENTER> to start at the beginning of the list.",!
+3 SET DIR(0)="FO"
+4 SET DIR("A")="START WITH '"_IBFLD(IBF)_"' VALUE"
+5 IF $PIECE($GET(IBCASE(IBF)),"^",2)'=""
SET DIR("B")=$PIECE($GET(IBCASE(IBF)),"^",2)
+6 SET DIR("?")="^D RANGE^IBCOMD(""BEGIN"")"
+7 DO ^DIR
KILL DIR
+8 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!(Y="^")
SET STOP=1
KILL IBCASE(IBF)
QUIT
+9 SET IBRF=Y
+10 ;
+11 ;IB*743/TAZ - Updated code to accept NULL to mean end of list.
+12 WRITE !!,"Enter Go To value or Press <ENTER> to finish at the end of the list.",!
+13 SET DIR(0)="FO"
+14 SET DIR("A")="GO TO '"_IBFLD(IBF)_"' VALUE"
+15 ; IB*743/DTG do not dispay 'zzzzzz' on edit
+16 IF ($PIECE($GET(IBCASE(IBF)),"^",3)'="")&($PIECE($GET(IBCASE(IBF)),"^",3)'="zzzzzz")
SET DIR("B")=$PIECE($GET(IBCASE(IBF)),"^",3)
+17 SET DIR("?")="^D RANGE^IBCOMD(""END"")"
+18 DO ^DIR
KILL DIR
+19 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!(Y="^")
SET STOP=1
KILL IBCASE(IBF)
QUIT
+20 SET IBRL=$SELECT(Y="":"zzzzzz",1:Y)
+21 ;
+22 ; - the 'go to' value must follow the 'start with' value
+23 ;IB*732/CKB - make selection case insensitive
+24 IF $$UP^XLFSTR($GET(IBRL))']$$UP^XLFSTR($GET(IBRF))
Begin DoDot:1
+25 WRITE !!,?5,">>>>> The 'Go To' value must follow after the 'Start With' value. <<<<<",!
End DoDot:1
GOTO SELRR
+26 SET IBCASE(IBF)="R^"_IBRF_"^"_IBRL
+27 QUIT
+28 ;
DISPLAY ;IB*732/CKB - Display the selected screening conditions
+1 NEW I,H
+2 WRITE !!,"The following conditions were selected:"
+3 SET (H,I)=0
FOR
SET I=$ORDER(IBCASE(I))
if 'I
QUIT
Begin DoDot:1
+4 WRITE !
IF H
WRITE ?3,"and"
+5 SET H=1
WRITE ?8,IBFLD(I)
+6 WRITE ?18,$SELECT(I=4:"Equals ",$PIECE(IBCASE(I),"^")="C":"Contains ",1:"Between ")
+7 WRITE $SELECT(I=4:$PIECE($GET(^DIC(5,+$PIECE(IBCASE(I),"^",2),0)),"^"),$PIECE(IBCASE(I),"^",2)="":"'FIRST'",1:$PIECE(IBCASE(I),"^",2))
+8 IF $PIECE(IBCASE(I),"^")="R"
WRITE " and ",$SELECT($PIECE(IBCASE(I),"^",3)="zzzzzz":"'LAST'",1:$PIECE(IBCASE(I),"^",3))
End DoDot:1
+9 QUIT
+10 ;
ENH ; Active, Inactive or Both help Text
+1 WRITE !!,?5,"Enter 1 to search Active Insurance Companies"
+2 WRITE !,?5,"Enter 2 to search Inactive Insurance Companies"
+3 WRITE !,?5,"Enter 3 to include Active and Inactive Insurance Companies in Report",!
+4 QUIT
+5 ;
FLD ;Field selection help text
+1 WRITE !!,?5,"Enter 1 to screen insurance company by Name"
+2 WRITE !,?5,"Enter 2 to screen insurance company by Street"
+3 WRITE !,?5,"Enter 3 to screen insurance company by City"
+4 WRITE !,?5,"Enter 4 to screen insurance company by State"
+5 QUIT
+6 ;
RAN ; Help for the Range/Contains prompt.
+1 WRITE !!,?5,"Enter 'R' to enter a 'Start From' and 'Go To' range, or 'C' to enter"
+2 WRITE !,?5,"a specific string that the field value must contain. Enter '^' to"
+3 WRITE !,?5,"eliminate this screen field and select another field."
+4 QUIT
+5 ;
CON ; Help for the 'Contains' prompt.
+1 WRITE !!,?5,"Enter a string that the field value should contain. Enter a <CR> to"
+2 WRITE !,?5,"find entries where the field value is null. Enter '^' to eliminate"
+3 WRITE !,?5,"this screen field and select another field."
+4 QUIT
+5 ;
+6 ;IB*743/TAZ - Help for the Range Prompt
RANGE(LEVEL) ; ?? Help for the Range Prompt
+1 WRITE !!,?5,"Enter a value the entries in the list should ",LEVEL," with."
+2 IF LEVEL="BEGIN"
WRITE !,?5,"Press <ENTER> to start at the beginning of the list."
+3 IF LEVEL="END"
WRITE !,?5,"Press <ENTER> to finish at the end of the list."
+4 QUIT
+5 ;
QUE ; Ask Device
+1 ;IB*732/CKB - Modified to allow Queuing of the report, and added Excel
+2 ; warning to prevent wrapping
+3 NEW ZTDESC,ZTRTN,ZTSAVE
+4 ;
+5 IF IBOUT="E"
Begin DoDot:1
+6 WRITE !!,"For CSV output, turn logging or capture on now. To avoid undesired wrapping"
+7 WRITE !,"of the data saved to the file, please enter ""0;256;99999"" at the ""DEVICE:"""
+8 WRITE !,"prompt.",!
End DoDot:1
+9 ;
+10 SET ZTRTN="BEG^IBCOMD1"
+11 SET ZTSAVE("IBAIB")=""
SET ZTSAVE("IBFLD(")=""
SET ZTSAVE("IBOUT")=""
+12 IF $DATA(IBCASE)
SET ZTSAVE("IBCASE(")=""
+13 SET ZTDESC="IB - Identify Dup Insurance Companies"
+14 ; ICR #1519
DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"Q")
QUEQ ;
+1 QUIT
+2 ;
OUT() ;
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 WRITE !
+3 SET DIR(0)="SA^E:Excel;R:Report"
+4 SET DIR("A")="(E)xcel Format or (R)eport Format: "
+5 SET DIR("B")="Report"
+6 DO ^DIR
IF $DATA(DIRUT)
QUIT ""
+7 QUIT Y
