| 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 |  ;
 | 
|---|