IBCEM2.m

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 ---IBCEM2   3709     printed  Mar 13, 2025@21:15:34                                                                                                                                                                                                      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       ;