| [613] | 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 | ; | 
|---|