IBCEM2 ;ALB/TMP - 837 EDI RETURN MSG EXTRACT MAIN LIST TEMPLATE ;02-MAY-96
;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
;
SCRIT(IBSCRIT) ; Enter display selection criteria
; Pass IBSCRIT by reference - returned containing selection criteria
; IBSCRIT(n)=n-level sort IBSCRIT(n,1-x)=selections
; IBSCRIT(n,"D1") = from DATE range IBSCRIT(n,"D2") = to DATE range
D FULL^VALM1
W !
S DIR("B")="ALL"
S DIR("A",1)="Enter sort and selection criteria for message list",DIR("A",2)=" ",DIR("A")="First level sort field: "
S DIR(0)="SA^MS:MESSAGE STATUS;MT:TYPE OF MESSAGE;BA:BATCH #;BI:BILL #;ALL:ALL MESSAGES"
S DIR("?")="Enter the top-level sort for the list of messages"
D ^DIR K DIR
I $D(DIRUT) K IBSCRIT Q
S IBSCRIT(1)=Y
I Y="ALL" Q
D SELECT(1,.IBSCRIT) Q:'$D(IBSCRIT)
S DIR("A",1)=" ",DIR("A")="Second level sort field: "
S DIR(0)="SAO^"_$S(IBSCRIT(1)'="MS":"MS:MESSAGE STATUS;",1:"")_$S(IBSCRIT(1)'="MT":"MT:TYPE OF MESSAGE;",1:"")_"MD:MESSAGE DATE;RD:RECORDED DATE"
S DIR("?")="Enter the second-level sort for the list of messages"
S DIR("?",1)="First level sort selected was: "_$$FLD(IBSCRIT(1))
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) K IBSCRIT Q
I Y="" Q
S IBSCRIT(2)=Y
D SELECT(2,.IBSCRIT) Q:'$D(IBSCRIT)
S DIR("A",1)=" ",DIR("A")="Third level sort field: "
S DIR(0)="SAO^"
S DIR(0)=DIR(0)_$S(IBSCRIT(1)'="MS"&(IBSCRIT(2)'="MS"):"MS:MESSAGE STATUS;",1:"")_$S(IBSCRIT(1)'="MT"&(IBSCRIT(2)'="MT"):"MT:TYPE OF MESSAGE;",1:"")
S DIR(0)=DIR(0)_$S(IBSCRIT(2)'="MD":"MD:MESSAGE DATE;",1:"")_$S(IBSCRIT(2)'="RD":"RD:RECORDED DATE",1:"")
S DIR("?")="Enter the third-level sort for the list of messages"
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) K IBSCRIT Q
I Y="" Q
S IBSCRIT(3)=Y
D SELECT(3,.IBSCRIT)
Q
;
SELECT(LEVEL,IBSCRIT) ; Select specific or all values/date range for IBSCRIT(LEVEL)
; LEVEL = sort level 1-3
N SELNM,SEL,CT,Y,DIR,DUOUT,DTOUT,DIRUT,Z
S SEL=$G(IBSCRIT(LEVEL)) I SEL="" K IBSCRIT Q
S SELNM=$$FLD(SEL)
RESEL S DIR("A")="Do you want ALL "_SELNM_"'s",DIR(0)="Y",DIR("?")="ANSWER YES TO INCLUDE ALL "_SELNM_" OR NO TO SELECT SPECIFIC VALUES OR RANGES"
D ^DIR K DIR
I $D(DIRUT) K IBSCRIT Q
I Y=1 Q
I SEL="MD"!(SEL="RD") D Q ;Date field
. S DIR("A")="From Date: ",DIR(0)="DA^:"_DT_":P",DIR("?")="Enter the earliest date you want included in the list" D ^DIR
. I $D(DIRUT) K IBSCRIT Q
. S IBSCRIT(LEVEL,"D1")=Y I 'X W " ",$$FMTE^XLFDT(Y,2)
. S DIR("A")="To Date: ",DIR(0)="DA^:"_DT_":P",DIR("?")="Enter the latest date you want included in the list" D ^DIR
. I $D(DIRUT) K IBSCRIT Q
. S IBSCRIT(LEVEL,"D2")=Y I 'X W " ",$$FMTE^XLFDT(Y,2)
S CT=0
S DIR("A",1)=" ",DIR("A",2)="Enter your selections one at a time.",DIR("A",3)="When done, press return at the "_SELNM_" prompt to continue."
S DIR("A")=SELNM_": ",DIR(0)=$S(SEL="MS":"364.2,.06",SEL="MT":"364.2,.02",SEL="BA":"364.2,.04",SEL="BI":"364,.01",1:"")_"AO"
F D ^DIR D Q:"^"[Y
. Q:$D(DUOUT)
. I Y="" Q:CT W !,*7,"You must select at least one entry" S Y=-1 Q
. S CT=CT+1,IBSCRIT(LEVEL,$P(Y,U))=Y
. I $D(DIR("A",1)) F Z=1:1:3 K DIR("A",Z)
K DIR
I $D(DUOUT)!$D(DTOUT) D I $D(IBSCRIT) K IBSCRIT(LEVEL) S IBSCRIT(LEVEL)=SEL G RESEL
. S DIR(0)="Y",DIR("A",1)=" ",DIR("A")="Do you want to abort this entire sort/selection"
. S DIR("?")="Answer YES if you want to abort or to re-enter all sort/selection criteria",DIR("?",1)="Answer NO if you want to re-enter just this sort level's criteria"
. D ^DIR K DIR
. I $D(DIRUT)!Y K IBSCRIT
Q
;
FLD(FLD) ; RETURN NAME OF FIELD
Q $S(FLD="MS":"MESSAGE STATUS",FLD="MT":"TYPE OF MESSAGE",FLD="BA":"BATCH",FLD="BI":"BILL",FLD="MD":"MESSAGE DATE",FLD="RD":"DATE RECORDED",1:"")
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEM2 3709 printed Dec 13, 2024@02:10:45 Page 2
IBCEM2 ;ALB/TMP - 837 EDI RETURN MSG EXTRACT MAIN LIST TEMPLATE ;02-MAY-96
+1 ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
+2 ;
SCRIT(IBSCRIT) ; Enter display selection criteria
+1 ; Pass IBSCRIT by reference - returned containing selection criteria
+2 ; IBSCRIT(n)=n-level sort IBSCRIT(n,1-x)=selections
+3 ; IBSCRIT(n,"D1") = from DATE range IBSCRIT(n,"D2") = to DATE range
+4 DO FULL^VALM1
+5 WRITE !
+6 SET DIR("B")="ALL"
+7 SET DIR("A",1)="Enter sort and selection criteria for message list"
SET DIR("A",2)=" "
SET DIR("A")="First level sort field: "
+8 SET DIR(0)="SA^MS:MESSAGE STATUS;MT:TYPE OF MESSAGE;BA:BATCH #;BI:BILL #;ALL:ALL MESSAGES"
+9 SET DIR("?")="Enter the top-level sort for the list of messages"
+10 DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
KILL IBSCRIT
QUIT
+12 SET IBSCRIT(1)=Y
+13 IF Y="ALL"
QUIT
+14 DO SELECT(1,.IBSCRIT)
if '$DATA(IBSCRIT)
QUIT
+15 SET DIR("A",1)=" "
SET DIR("A")="Second level sort field: "
+16 SET DIR(0)="SAO^"_$SELECT(IBSCRIT(1)'="MS":"MS:MESSAGE STATUS;",1:"")_$SELECT(IBSCRIT(1)'="MT":"MT:TYPE OF MESSAGE;",1:"")_"MD:MESSAGE DATE;RD:RECORDED DATE"
+17 SET DIR("?")="Enter the second-level sort for the list of messages"
+18 SET DIR("?",1)="First level sort selected was: "_$$FLD(IBSCRIT(1))
+19 DO ^DIR
KILL DIR
+20 IF $DATA(DTOUT)!$DATA(DUOUT)
KILL IBSCRIT
QUIT
+21 IF Y=""
QUIT
+22 SET IBSCRIT(2)=Y
+23 DO SELECT(2,.IBSCRIT)
if '$DATA(IBSCRIT)
QUIT
+24 SET DIR("A",1)=" "
SET DIR("A")="Third level sort field: "
+25 SET DIR(0)="SAO^"
+26 SET DIR(0)=DIR(0)_$SELECT(IBSCRIT(1)'="MS"&(IBSCRIT(2)'="MS"):"MS:MESSAGE STATUS;",1:"")_$SELECT(IBSCRIT(1)'="MT"&(IBSCRIT(2)'="MT"):"MT:TYPE OF MESSAGE;",1:"")
+27 SET DIR(0)=DIR(0)_$SELECT(IBSCRIT(2)'="MD":"MD:MESSAGE DATE;",1:"")_$SELECT(IBSCRIT(2)'="RD":"RD:RECORDED DATE",1:"")
+28 SET DIR("?")="Enter the third-level sort for the list of messages"
+29 DO ^DIR
KILL DIR
+30 IF $DATA(DTOUT)!$DATA(DUOUT)
KILL IBSCRIT
QUIT
+31 IF Y=""
QUIT
+32 SET IBSCRIT(3)=Y
+33 DO SELECT(3,.IBSCRIT)
+34 QUIT
+35 ;
SELECT(LEVEL,IBSCRIT) ; Select specific or all values/date range for IBSCRIT(LEVEL)
+1 ; LEVEL = sort level 1-3
+2 NEW SELNM,SEL,CT,Y,DIR,DUOUT,DTOUT,DIRUT,Z
+3 SET SEL=$GET(IBSCRIT(LEVEL))
IF SEL=""
KILL IBSCRIT
QUIT
+4 SET SELNM=$$FLD(SEL)
RESEL SET DIR("A")="Do you want ALL "_SELNM_"'s"
SET DIR(0)="Y"
SET DIR("?")="ANSWER YES TO INCLUDE ALL "_SELNM_" OR NO TO SELECT SPECIFIC VALUES OR RANGES"
+1 DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
KILL IBSCRIT
QUIT
+3 IF Y=1
QUIT
+4 ;Date field
IF SEL="MD"!(SEL="RD")
Begin DoDot:1
+5 SET DIR("A")="From Date: "
SET DIR(0)="DA^:"_DT_":P"
SET DIR("?")="Enter the earliest date you want included in the list"
DO ^DIR
+6 IF $DATA(DIRUT)
KILL IBSCRIT
QUIT
+7 SET IBSCRIT(LEVEL,"D1")=Y
IF 'X
WRITE " ",$$FMTE^XLFDT(Y,2)
+8 SET DIR("A")="To Date: "
SET DIR(0)="DA^:"_DT_":P"
SET DIR("?")="Enter the latest date you want included in the list"
DO ^DIR
+9 IF $DATA(DIRUT)
KILL IBSCRIT
QUIT
+10 SET IBSCRIT(LEVEL,"D2")=Y
IF 'X
WRITE " ",$$FMTE^XLFDT(Y,2)
End DoDot:1
QUIT
+11 SET CT=0
+12 SET DIR("A",1)=" "
SET DIR("A",2)="Enter your selections one at a time."
SET DIR("A",3)="When done, press return at the "_SELNM_" prompt to continue."
+13 SET DIR("A")=SELNM_": "
SET DIR(0)=$SELECT(SEL="MS":"364.2,.06",SEL="MT":"364.2,.02",SEL="BA":"364.2,.04",SEL="BI":"364,.01",1:"")_"AO"
+14 FOR
DO ^DIR
Begin DoDot:1
+15 if $DATA(DUOUT)
QUIT
+16 IF Y=""
if CT
QUIT
WRITE !,*7,"You must select at least one entry"
SET Y=-1
QUIT
+17 SET CT=CT+1
SET IBSCRIT(LEVEL,$PIECE(Y,U))=Y
+18 IF $DATA(DIR("A",1))
FOR Z=1:1:3
KILL DIR("A",Z)
End DoDot:1
if "^"[Y
QUIT
+19 KILL DIR
+20 IF $DATA(DUOUT)!$DATA(DTOUT)
Begin DoDot:1
+21 SET DIR(0)="Y"
SET DIR("A",1)=" "
SET DIR("A")="Do you want to abort this entire sort/selection"
+22 SET DIR("?")="Answer YES if you want to abort or to re-enter all sort/selection criteria"
SET DIR("?",1)="Answer NO if you want to re-enter just this sort level's criteria"
+23 DO ^DIR
KILL DIR
+24 IF $DATA(DIRUT)!Y
KILL IBSCRIT
End DoDot:1
IF $DATA(IBSCRIT)
KILL IBSCRIT(LEVEL)
SET IBSCRIT(LEVEL)=SEL
GOTO RESEL
+25 QUIT
+26 ;
FLD(FLD) ; RETURN NAME OF FIELD
+1 QUIT $SELECT(FLD="MS":"MESSAGE STATUS",FLD="MT":"TYPE OF MESSAGE",FLD="BA":"BATCH",FLD="BI":"BILL",FLD="MD":"MESSAGE DATE",FLD="RD":"DATE RECORDED",1:"")
+2 ;
