IBCEMSG1.m

IBCEMSG1 ;ALB/JEH - EDI PURGE STATUS MESSAGES CONT. ;04-MAY-01

 ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

EN ; - main entry

 N IBDELDT,IBIEN,IBMSG,IBSORT,IBQUIT,IBFNR,IBFRD,IBREC,IBNUM,IBSEV,IB0,IBK

 D EN^VALM("IBCEM STATUS MESSAGE")

 Q

HDR ; -- header code

 S VALMHDR(1)="Selected by "_$S(IBSORT="A":"Auto Filed/No Review",IBSORT="B":"Bill Number: "_IBNUM,IBSORT="S":"Message Severity: "_IBSEV,1:"Message Text containing word or phrase "_IBMSG)

 S VALMHDR(2)="Reviewed Prior to: "_$$FMTE^XLFDT(IBDELDT,"2D")

 Q

 ;

INIT ; -- set up variables

 N DIR,X,Y

 K ^TMP("IBCEMSGA",$J)

 S DIR("A")="Select messages based on"

 S DIR(0)="S^A:Auto Filed/No Review Only;B:Bill Number;S:Message Severity;T:Specific Message Text"

 D ^DIR K DIR

 I $D(DTOUT)!$D(DUOUT)!(Y<0) S VALMQUIT=1 G INITQ

 S IBSORT=Y

 I IBSORT="B" D  G:$G(VALMQUIT) INITQ

 . S DIR("A")="Enter Bill Number"

 . S DIR(0)="P^361:AEMQZ"

 . D ^DIR K DIR

 . I $D(DTOUT)!$D(DUOUT)!(Y<0) S VALMQUIT=1 Q

 . S IBIEN=$P(Y,U,2),IBNUM=$$BN1^PRCAFN(IBIEN)

 I IBSORT="S" D  G:$G(VALMQUIT) INITQ

 . S DIR("A")="(I)nformation/Warning or (R)ejection"

 . S DIR(0)="SB^I:Information/Warning;R:Rejection"

 . D ^DIR K DIR

 . I $D(DUOUT)!$D(DTOUT)!(Y<0) S VALMQUIT=1 Q

 . S IBSEV=Y

 I IBSORT="T" D  G:$G(VALMQUIT) INITQ

 . S DIR("A")="Enter specific word or phrase the message should contain to be deleted"

 . S DIR(0)="F^5:15^K:X'?.U X"

 . D ^DIR K DIR

 . I $D(DUOUT)!$D(DTOUT)!(Y<0) S VALMQUIT=1 Q

 . S IBMSG=Y

 S DIR("A")="INCLUDE STATUS MESSAGES REVIEWED PRIOR TO"

 S DIR(0)="D^:DTP:EX" W ! D ^DIR K DIR

 I $D(DTOUT)!$D(DUOUT) S VALMQUIT=1 Q

 S IBDELDT=Y

 D @IBSORT

 D BLD^IBCEMSG2

INITQ ;

 Q

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

EXIT ; -- clean up and exit

 K ^TMP("IBCEMSGA",$J),^TMP("IBCEMSGB",$J)

 D CLEAN^VALM10

 Q

A ; -- sort by auto filed

 S IBK=0 F  S IBK=$O(^IBM(361,"ANR",1,IBK)) Q:'IBK  S IB0=$G(^IBM(361,IBK,0)) D

 . I '$P(IB0,U,13)!($P(IB0,U,13)>IBDELDT) Q

 . D SET

 Q

 ;

B ; -- sort by bill number

 S IBK=0 F  S IBK=$O(^IBM(361,"B",IBIEN,IBK)) Q:'IBK  S IB0=$G(^IBM(361,IBK,0)) D

 . I '$P(IB0,U,13)!($P(IB0,U,13)>IBDELDT) Q

 . D SET

 Q

 ;

S ; -- sort by message severity

 S IBK=0 F  S IBK=$O(^IBM(361,"ASV",IBSEV,IBK)) Q:'IBK  S IB0=$G(^IBM(361,IBK,0)) D

 . I '$P(IB0,U,13)!($P(IB0,U,13)>IBDELDT) Q

 . D SET

 Q

 ;

T ; -- sort by message text

 N Z,IBTXT,IB,IBDT

 S IBDT=0 F  S IBDT=$O(^IBM(361,"AFR",IBDT)) Q:'IBDT!(IBDT>IBDELDT)  S IBK=0 F  S IBK=$O(^IBM(361,"AFR",IBDT,IBK)) Q:'IBK  S IB0=$G(^IBM(361,IBK,0)) D

 . I '$O(^IBM(361,IBK,1,0)) Q

 . S IB=0 F  S IB=$O(^IBM(361,IBK,1,IB)) Q:'IB  S Z=$G(^IBM(361,IBK,1,IB,0)) I $$UPPER^VALM1(Z)[IBMSG S IBTXT=$E(Z,1,60) D

 .. D SET

 .. S ^TMP("IBCEMSGA",$J,IBK)=^TMP("IBCEMSGA",$J,IBK)_U_IBTXT

 Q

 ;

SET S IBNUM=$$BN1^PRCAFN($P(IB0,U))

 S IBSEV=$$EXPAND^IBTRE(361,.03,$P(IB0,U,3))

 S IBFNR=$$EXPAND^IBTRE(361,.1,$P(IB0,U,10))

 S IBFRD=$$DAT1^IBOUTL($P(IB0,U,13))

 S IBAUTO=$$EXPAND^IBTRE(361,.14,$P(IB0,U,14))

 S ^TMP("IBCEMSGA",$J,IBK)=IBNUM_U_IBSEV_U_IBFNR_U_IBFRD_U_IBAUTO

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBCEMSG1   3147     printed  Apr 23, 2025@18:25:34                                                                                                                                                                                                    Page 2

IBCEMSG1  ;ALB/JEH - EDI PURGE STATUS MESSAGES CONT. ;04-MAY-01

 +1       ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

EN        ; - main entry

 +1        NEW IBDELDT,IBIEN,IBMSG,IBSORT,IBQUIT,IBFNR,IBFRD,IBREC,IBNUM,IBSEV,IB0,IBK

 +2        DO EN^VALM("IBCEM STATUS MESSAGE")

 +3        QUIT 

HDR       ; -- header code

 +1        SET VALMHDR(1)="Selected by "_$SELECT(IBSORT="A":"Auto Filed/No Review",IBSORT="B":"Bill Number: "_IBNUM,IBSORT="S":"Message Severity: "_IBSEV,1:"Message Text containing word or phrase "_IBMSG)

 +2        SET VALMHDR(2)="Reviewed Prior to: "_$$FMTE^XLFDT(IBDELDT,"2D")

 +3        QUIT 

 +4       ;

INIT      ; -- set up variables

 +1        NEW DIR,X,Y

 +2        KILL ^TMP("IBCEMSGA",$JOB)

 +3        SET DIR("A")="Select messages based on"

 +4        SET DIR(0)="S^A:Auto Filed/No Review Only;B:Bill Number;S:Message Severity;T:Specific Message Text"

 +5        DO ^DIR

           KILL DIR

 +6        IF $DATA(DTOUT)!$DATA(DUOUT)!(Y<0)

               SET VALMQUIT=1

               GOTO INITQ

 +7        SET IBSORT=Y

 +8        IF IBSORT="B"

               Begin DoDot:1

 +9                SET DIR("A")="Enter Bill Number"

 +10               SET DIR(0)="P^361:AEMQZ"

 +11               DO ^DIR

                   KILL DIR

 +12               IF $DATA(DTOUT)!$DATA(DUOUT)!(Y<0)

                       SET VALMQUIT=1

                       QUIT 

 +13               SET IBIEN=$PIECE(Y,U,2)

                   SET IBNUM=$$BN1^PRCAFN(IBIEN)

               End DoDot:1

               if $GET(VALMQUIT)

                   GOTO INITQ

 +14       IF IBSORT="S"

               Begin DoDot:1

 +15               SET DIR("A")="(I)nformation/Warning or (R)ejection"

 +16               SET DIR(0)="SB^I:Information/Warning;R:Rejection"

 +17               DO ^DIR

                   KILL DIR

 +18               IF $DATA(DUOUT)!$DATA(DTOUT)!(Y<0)

                       SET VALMQUIT=1

                       QUIT 

 +19               SET IBSEV=Y

               End DoDot:1

               if $GET(VALMQUIT)

                   GOTO INITQ

 +20       IF IBSORT="T"

               Begin DoDot:1

 +21               SET DIR("A")="Enter specific word or phrase the message should contain to be deleted"

 +22               SET DIR(0)="F^5:15^K:X'?.U X"

 +23               DO ^DIR

                   KILL DIR

 +24               IF $DATA(DUOUT)!$DATA(DTOUT)!(Y<0)

                       SET VALMQUIT=1

                       QUIT 

 +25               SET IBMSG=Y

               End DoDot:1

               if $GET(VALMQUIT)

                   GOTO INITQ

 +26       SET DIR("A")="INCLUDE STATUS MESSAGES REVIEWED PRIOR TO"

 +27       SET DIR(0)="D^:DTP:EX"

           WRITE !

           DO ^DIR

           KILL DIR

 +28       IF $DATA(DTOUT)!$DATA(DUOUT)

               SET VALMQUIT=1

               QUIT 

 +29       SET IBDELDT=Y

 +30       DO @IBSORT

 +31       DO BLD^IBCEMSG2

INITQ     ;

 +1        QUIT 

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

EXIT      ; -- clean up and exit

 +1        KILL ^TMP("IBCEMSGA",$JOB),^TMP("IBCEMSGB",$JOB)

 +2        DO CLEAN^VALM10

 +3        QUIT 

A         ; -- sort by auto filed

 +1        SET IBK=0

           FOR 

               SET IBK=$ORDER(^IBM(361,"ANR",1,IBK))

               if 'IBK

                   QUIT 

               SET IB0=$GET(^IBM(361,IBK,0))

               Begin DoDot:1

 +2                IF '$PIECE(IB0,U,13)!($PIECE(IB0,U,13)>IBDELDT)

                       QUIT 

 +3                DO SET

               End DoDot:1

 +4        QUIT 

 +5       ;

B         ; -- sort by bill number

 +1        SET IBK=0

           FOR 

               SET IBK=$ORDER(^IBM(361,"B",IBIEN,IBK))

               if 'IBK

                   QUIT 

               SET IB0=$GET(^IBM(361,IBK,0))

               Begin DoDot:1

 +2                IF '$PIECE(IB0,U,13)!($PIECE(IB0,U,13)>IBDELDT)

                       QUIT 

 +3                DO SET

               End DoDot:1

 +4        QUIT 

 +5       ;

S         ; -- sort by message severity

 +1        SET IBK=0

           FOR 

               SET IBK=$ORDER(^IBM(361,"ASV",IBSEV,IBK))

               if 'IBK

                   QUIT 

               SET IB0=$GET(^IBM(361,IBK,0))

               Begin DoDot:1

 +2                IF '$PIECE(IB0,U,13)!($PIECE(IB0,U,13)>IBDELDT)

                       QUIT 

 +3                DO SET

               End DoDot:1

 +4        QUIT 

 +5       ;

T         ; -- sort by message text

 +1        NEW Z,IBTXT,IB,IBDT

 +2        SET IBDT=0

           FOR 

               SET IBDT=$ORDER(^IBM(361,"AFR",IBDT))

               if 'IBDT!(IBDT>IBDELDT)

                   QUIT 

               SET IBK=0

               FOR 

                   SET IBK=$ORDER(^IBM(361,"AFR",IBDT,IBK))

                   if 'IBK

                       QUIT 

                   SET IB0=$GET(^IBM(361,IBK,0))

                   Begin DoDot:1

 +3                    IF '$ORDER(^IBM(361,IBK,1,0))

                           QUIT 

 +4                    SET IB=0

                       FOR 

                           SET IB=$ORDER(^IBM(361,IBK,1,IB))

                           if 'IB

                               QUIT 

                           SET Z=$GET(^IBM(361,IBK,1,IB,0))

                           IF $$UPPER^VALM1(Z)[IBMSG

                               SET IBTXT=$EXTRACT(Z,1,60)

                               Begin DoDot:2

 +5                                DO SET

 +6                                SET ^TMP("IBCEMSGA",$JOB,IBK)=^TMP("IBCEMSGA",$JOB,IBK)_U_IBTXT

                               End DoDot:2

                   End DoDot:1

 +7        QUIT 

 +8       ;

SET        SET IBNUM=$$BN1^PRCAFN($PIECE(IB0,U))

 +1        SET IBSEV=$$EXPAND^IBTRE(361,.03,$PIECE(IB0,U,3))

 +2        SET IBFNR=$$EXPAND^IBTRE(361,.1,$PIECE(IB0,U,10))

 +3        SET IBFRD=$$DAT1^IBOUTL($PIECE(IB0,U,13))

 +4        SET IBAUTO=$$EXPAND^IBTRE(361,.14,$PIECE(IB0,U,14))

 +5        SET ^TMP("IBCEMSGA",$JOB,IBK)=IBNUM_U_IBSEV_U_IBFNR_U_IBFRD_U_IBAUTO

 +6        QUIT