IBCEMSG2 ;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.
;
BLD ; -- build list
K ^TMP("IBCEMSGB",$J)
N IBI,IB0,IBREC,IBCNT
S (IBCNT,VALMCNT)=0
I '$D(^TMP("IBCEMSGA",$J)) D
. S (IBCNT,VALMCNT)=2
. S ^TMP("IBCEMSGB",$J,1,0)=""
. S ^TMP("IBCEMSGB",$J,2,0)="No status messages matching selection criteria were found"
S IBI=0 F S IBI=$O(^TMP("IBCEMSGA",$J,IBI)) Q:'IBI S IBREC=^(IBI) D
. S IBCNT=IBCNT+1,X=""
. S X=$$SETFLD^VALM1(IBCNT,"","NUMBER")
. S X=$$SETFLD^VALM1($P(IBREC,U),X,"BILL")
. S X=$$SETFLD^VALM1($P(IBREC,U,2),X,"SEV")
. S X=$$SETFLD^VALM1($P(IBREC,U,3),X,"FNR")
. S X=$$SETFLD^VALM1($P(IBREC,U,4),X,"FRD")
. S X=$$SETFLD^VALM1($P(IBREC,U,5),X,"AUTO")
. D SET(X)
. I $P(IBREC,U,6)'="" S X=$$SETSTR^VALM1($P(IBREC,U,6),"",5,200) D SET(X)
Q
;
SET(X) ; -- list manager screen
S VALMCNT=VALMCNT+1
S ^TMP("IBCEMSGB",$J,VALMCNT,0)=X
S ^TMP("IBCEMSGB",$J,"IDX",VALMCNT,IBCNT)=""
S ^TMP("IBCEMSGB",$J,IBCNT)=VALMCNT_U_IBI
Q
;
DEL ; -- entry point to delete status message
N IBDA,DA,DIK,IBCNT
D SEL(.IBDA)
G:'$O(IBDA(0)) DELQ
S (DA,IBCNT)=0,DIK="^IBM(361," F S IBDA=$O(IBDA(IBDA)) Q:'IBDA S DA=IBDA(IBDA) D ^DIK K ^TMP("IBCEMSGA",$J,DA) S IBCNT=IBCNT+1
W !!,IBCNT_$S(IBCNT>1:" Messages",1:" Message")_" deleted"
D PAUSE^VALM1,BLD
K ^TMP("IBDA",$J)
DELQ S VALMBCK="R"
Q
;
VPRT ; -- entry point to view/print status messages
D SEL(.IBDA)
G:'$O(IBDA(0)) PRTQ
S DIC="^IBM(361,",L=0,DHD="Status Messages Selected for Deletion",FLDS="[CAPTION]",DIOBEG="I $E(IOST,1,2)=""C-"" W @IOF",BY(0)="^TMP(""IBDA"",$J,",L(0)=1 D EN1^DIP
D PAUSE^VALM1
K ^TMP("IBDA",$J)
PRTQ S VALMBCK="R"
Q
;
SEL(IBDA) ; -- select entry from list
D FULL^VALM1
D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S"))
S IBDA=0 F S IBDA=$O(VALMY(IBDA)) Q:'IBDA S IBDA(IBDA)=$P($G(^TMP("IBCEMSGB",$J,IBDA)),U,2) I IBDA(IBDA) S ^TMP("IBDA",$J,IBDA(IBDA))=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEMSG2 2048 printed Nov 22, 2024@17:21:08 Page 2
IBCEMSG2 ;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 ;
BLD ; -- build list
+1 KILL ^TMP("IBCEMSGB",$JOB)
+2 NEW IBI,IB0,IBREC,IBCNT
+3 SET (IBCNT,VALMCNT)=0
+4 IF '$DATA(^TMP("IBCEMSGA",$JOB))
Begin DoDot:1
+5 SET (IBCNT,VALMCNT)=2
+6 SET ^TMP("IBCEMSGB",$JOB,1,0)=""
+7 SET ^TMP("IBCEMSGB",$JOB,2,0)="No status messages matching selection criteria were found"
End DoDot:1
+8 SET IBI=0
FOR
SET IBI=$ORDER(^TMP("IBCEMSGA",$JOB,IBI))
if 'IBI
QUIT
SET IBREC=^(IBI)
Begin DoDot:1
+9 SET IBCNT=IBCNT+1
SET X=""
+10 SET X=$$SETFLD^VALM1(IBCNT,"","NUMBER")
+11 SET X=$$SETFLD^VALM1($PIECE(IBREC,U),X,"BILL")
+12 SET X=$$SETFLD^VALM1($PIECE(IBREC,U,2),X,"SEV")
+13 SET X=$$SETFLD^VALM1($PIECE(IBREC,U,3),X,"FNR")
+14 SET X=$$SETFLD^VALM1($PIECE(IBREC,U,4),X,"FRD")
+15 SET X=$$SETFLD^VALM1($PIECE(IBREC,U,5),X,"AUTO")
+16 DO SET(X)
+17 IF $PIECE(IBREC,U,6)'=""
SET X=$$SETSTR^VALM1($PIECE(IBREC,U,6),"",5,200)
DO SET(X)
End DoDot:1
+18 QUIT
+19 ;
SET(X) ; -- list manager screen
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("IBCEMSGB",$JOB,VALMCNT,0)=X
+3 SET ^TMP("IBCEMSGB",$JOB,"IDX",VALMCNT,IBCNT)=""
+4 SET ^TMP("IBCEMSGB",$JOB,IBCNT)=VALMCNT_U_IBI
+5 QUIT
+6 ;
DEL ; -- entry point to delete status message
+1 NEW IBDA,DA,DIK,IBCNT
+2 DO SEL(.IBDA)
+3 if '$ORDER(IBDA(0))
GOTO DELQ
+4 SET (DA,IBCNT)=0
SET DIK="^IBM(361,"
FOR
SET IBDA=$ORDER(IBDA(IBDA))
if 'IBDA
QUIT
SET DA=IBDA(IBDA)
DO ^DIK
KILL ^TMP("IBCEMSGA",$JOB,DA)
SET IBCNT=IBCNT+1
+5 WRITE !!,IBCNT_$SELECT(IBCNT>1:" Messages",1:" Message")_" deleted"
+6 DO PAUSE^VALM1
DO BLD
+7 KILL ^TMP("IBDA",$JOB)
DELQ SET VALMBCK="R"
+1 QUIT
+2 ;
VPRT ; -- entry point to view/print status messages
+1 DO SEL(.IBDA)
+2 if '$ORDER(IBDA(0))
GOTO PRTQ
+3 SET DIC="^IBM(361,"
SET L=0
SET DHD="Status Messages Selected for Deletion"
SET FLDS="[CAPTION]"
SET DIOBEG="I $E(IOST,1,2)=""C-"" W @IOF"
SET BY(0)="^TMP(""IBDA"",$J,"
SET L(0)=1
DO EN1^DIP
+4 DO PAUSE^VALM1
+5 KILL ^TMP("IBDA",$JOB)
PRTQ SET VALMBCK="R"
+1 QUIT
+2 ;
SEL(IBDA) ; -- select entry from list
+1 DO FULL^VALM1
+2 DO EN^VALM2($GET(XQORNOD(0)),$SELECT('$GET(ONE):"",1:"S"))
+3 SET IBDA=0
FOR
SET IBDA=$ORDER(VALMY(IBDA))
if 'IBDA
QUIT
SET IBDA(IBDA)=$PIECE($GET(^TMP("IBCEMSGB",$JOB,IBDA)),U,2)
IF IBDA(IBDA)
SET ^TMP("IBDA",$JOB,IBDA(IBDA))=""
+4 QUIT
+5 ;
