| 1 | IBCEMSG2 ;ALB/JEH - EDI PURGE STATUS MESSAGES CONT. ;04-MAY-01 | 
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94 | 
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified. | 
|---|
| 4 | ; | 
|---|
| 5 | BLD ; -- build list | 
|---|
| 6 | K ^TMP("IBCEMSGB",$J) | 
|---|
| 7 | N IBI,IB0,IBREC,IBCNT | 
|---|
| 8 | S (IBCNT,VALMCNT)=0 | 
|---|
| 9 | I '$D(^TMP("IBCEMSGA",$J)) D | 
|---|
| 10 | . S (IBCNT,VALMCNT)=2 | 
|---|
| 11 | . S ^TMP("IBCEMSGB",$J,1,0)="" | 
|---|
| 12 | . S ^TMP("IBCEMSGB",$J,2,0)="No status messages matching selection criteria were found" | 
|---|
| 13 | S IBI=0 F  S IBI=$O(^TMP("IBCEMSGA",$J,IBI)) Q:'IBI  S IBREC=^(IBI) D | 
|---|
| 14 | . S IBCNT=IBCNT+1,X="" | 
|---|
| 15 | . S X=$$SETFLD^VALM1(IBCNT,"","NUMBER") | 
|---|
| 16 | . S X=$$SETFLD^VALM1($P(IBREC,U),X,"BILL") | 
|---|
| 17 | . S X=$$SETFLD^VALM1($P(IBREC,U,2),X,"SEV") | 
|---|
| 18 | . S X=$$SETFLD^VALM1($P(IBREC,U,3),X,"FNR") | 
|---|
| 19 | . S X=$$SETFLD^VALM1($P(IBREC,U,4),X,"FRD") | 
|---|
| 20 | . S X=$$SETFLD^VALM1($P(IBREC,U,5),X,"AUTO") | 
|---|
| 21 | . D SET(X) | 
|---|
| 22 | . I $P(IBREC,U,6)'="" S X=$$SETSTR^VALM1($P(IBREC,U,6),"",5,200) D SET(X) | 
|---|
| 23 | Q | 
|---|
| 24 | ; | 
|---|
| 25 | SET(X) ; -- list manager screen | 
|---|
| 26 | S VALMCNT=VALMCNT+1 | 
|---|
| 27 | S ^TMP("IBCEMSGB",$J,VALMCNT,0)=X | 
|---|
| 28 | S ^TMP("IBCEMSGB",$J,"IDX",VALMCNT,IBCNT)="" | 
|---|
| 29 | S ^TMP("IBCEMSGB",$J,IBCNT)=VALMCNT_U_IBI | 
|---|
| 30 | Q | 
|---|
| 31 | ; | 
|---|
| 32 | DEL ; -- entry point to delete status message | 
|---|
| 33 | N IBDA,DA,DIK,IBCNT | 
|---|
| 34 | D SEL(.IBDA) | 
|---|
| 35 | G:'$O(IBDA(0)) DELQ | 
|---|
| 36 | 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 | 
|---|
| 37 | W !!,IBCNT_$S(IBCNT>1:" Messages",1:" Message")_" deleted" | 
|---|
| 38 | D PAUSE^VALM1,BLD | 
|---|
| 39 | K ^TMP("IBDA",$J) | 
|---|
| 40 | DELQ S VALMBCK="R" | 
|---|
| 41 | Q | 
|---|
| 42 | ; | 
|---|
| 43 | VPRT ; -- entry point to view/print status messages | 
|---|
| 44 | D SEL(.IBDA) | 
|---|
| 45 | G:'$O(IBDA(0)) PRTQ | 
|---|
| 46 | 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 | 
|---|
| 47 | D PAUSE^VALM1 | 
|---|
| 48 | K ^TMP("IBDA",$J) | 
|---|
| 49 | PRTQ S VALMBCK="R" | 
|---|
| 50 | Q | 
|---|
| 51 | ; | 
|---|
| 52 | SEL(IBDA) ; -- select entry from list | 
|---|
| 53 | D FULL^VALM1 | 
|---|
| 54 | D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S")) | 
|---|
| 55 | 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))="" | 
|---|
| 56 | Q | 
|---|
| 57 | ; | 
|---|