- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEM.m
r613 r623 1 IBCEM ;ALB/TMP - 837 EDI RETURN MESSAGE PROCESSING ;17-APR-96 2 ;;2.0;INTEGRATED BILLING;**137,191,155,371**;21-MAR-94;Build 57 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 Q 5 ; 6 UPD ; Update messages manually from messages list 7 N IBDA,IBOK,IBTDA,ZTSK,IBTSK,IBTYP,IBU,IBU1,IB0 8 D FULL^VALM1 9 D SEL(.IBDA,1) 10 S IBDA=$O(IBDA("")) 11 I IBDA="" G UPDQ 12 S IBTDA=+IBDA(IBDA) 13 I '$$LOCK(IBTDA) G UPDQ 14 S IB0=$G(^IBA(364.2,IBTDA,0)) 15 ; 16 I IB0="" D G UPDQ 17 . W !,*7,"Message ",IBDA," is no longer in return message file" S IBOK="" 18 . D PAUSE^VALM1 19 I $P(IB0,U,11) S IBOK=1 D G:'IBOK UPDQ 20 . N ZTSK 21 . S ZTSK=$P(IB0,U,11) D STAT^%ZTLOAD Q:ZTSK(0)=0 ;Task not scheduled 22 . I "12"[ZTSK(1) W *7,!,"This message has already been scheduled for update. Task # is: ",$P(IB0,U,11) S IBOK="" D PAUSE^VALM1 23 ; 24 I $P(IB0,U,6)=""!("UP"'[$P(IB0,U,6)) D G UPDQ 25 . W !,*7,"Message status ("_$$EXPAND^IBTRE(364.2,.06,$P(IB0,U,6))_") is not appropriate for this action" 26 . D PAUSE^VALM1 27 ; 28 S IBTYP=$P($G(^IBE(364.3,+$P(IB0,U,2),0)),U) 29 S IBU=$S(IBTYP="REPORT":"MAILIT^IBCESRV2",IBTYP["837REC":"CON837^IBCESRV2",IBTYP["837REJ":"REJ837^IBCESRV2",IBTYP["835EOB":"EOB835^IBCESRV3",1:""),IBU1=$S(IBTYP["837":$E(IBTYP,$L(IBTYP)),1:2) 30 I IBU="" W !,*7,"This message has an invalid message type - can't update" D PAUSE^VALM1 G UPDQ 31 S IBTSK=$$TASK(IBU,$P(IB0,U,4),IBTDA,IBU1) 32 I IBTSK W !,"Update has been tasked (#",IBTSK,")" 33 I 'IBTSK W !,*7,"Update could not be tasked. Please try again later!!!" 34 D PAUSE^VALM1 35 ; 36 D BLD^IBCEM1 37 UPDQ I $G(IBTDA) L -^IBA(364.2,IBTDA,0) 38 S VALMBCK="R" 39 Q 40 ; 41 VP ; View/Print Return Messages 42 N DHD,DIC,FLDS,BY,FR,TO,DIR,Y,L,IBDA,IBTDA,IBBILLS 43 D FULL^VALM1,SEL(.IBDA,1) 44 S IBDA=$O(IBDA("")) 45 G:'IBDA VPQ 46 S IBTDA=$G(IBDA(IBDA)),IBBILLS="" 47 I $P($G(^IBA(364.2,IBTDA,0)),U,4),'$P(^(0),U,5) D 48 .S DIR(0)="YA",DIR("B")="NO",DIR("A")="Do you want to list all bills for this batch?: " D ^DIR K DIR 49 .I Y S IBBILLS=1 50 S DHD=$S(IBBILLS:"[IBCEM MESSAGE LIST HDR]",1:""),DIC="^IBA(364.2,",FLDS=$S(IBBILLS:"[IBCEM MESSAGE LIST]",1:"[CAPTIONED]"),BY="@NUMBER",(FR,TO)=$G(IBDA(IBDA)),L=0 D EN1^DIP 51 D PAUSE^VALM1 52 VPQ S VALMBCK="R" 53 Q 54 ; 55 SEL(IBDA,ONE) ; Select entry(s) from list 56 ; IBDA = array returned if selections made 57 ; IBDA(n)=ien of bill selected in file 399 58 ; ONE = if set to 1, only one selection can be made at a time 59 N IB 60 K IBDA 61 D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S")) 62 S IBDA=0 F S IBDA=$O(VALMY(IBDA)) Q:'IBDA S IB=$G(^TMP("IBCEM-837DX",$J,IBDA)),IBDA(IBDA)=+$P(IB,U,2) 63 Q 64 ; 65 UPDEDI(IBDA,FUNC,NOCT) ; Update EDI files - cancel/resubmit/print as 66 ; resolution to message 67 ; IBDA = transmit bill ien # for bill 68 ; FUNC = "E" for edit/resubmit, "C" for cancel, "R" for resubmit not 69 ; from edit, "P" for print, "Z" for COB processed , "N" for no 70 ; further action needed-close record 71 ; NOCT = 1 if not necessary to update batch count, 0 if update needed 72 ; 73 N IB0,IBBA,IBBDA,IBCT,IBM,IBTDA,IBNEW,DA,DIE,DR,Z,IBTEXT,IBZ,IBIFN,IBSTAT 74 S IB0=$G(^IBA(364,+IBDA,0)),IBBA=$P(IB0,U,2) 75 Q:IB0="" S IBIFN=+IB0 76 ; 77 S IBNEW=$S(FUNC="E"!(FUNC="R"):+$P($G(^IBA(364,+$$LAST364^IBCEF4(+IB0),0)),U,2),1:"") S:IBNEW=IBBA IBNEW="" 78 ; 79 S IBSTAT=$P(IB0,U,3) ; current status in file 364 80 I '$F(".C.R.E.Z.","."_IBSTAT_".") D ; don't update if in final status 81 . S DR=".03////"_$S(FUNC="E":"R","NP"'[FUNC:FUNC,1:"Z")_";.04///NOW" S:FUNC="E"!(FUNC="R") DR=DR_$S(IBNEW:";.06////"_IBNEW,1:"") 82 . S DA=+IBDA,DIE="^IBA(364," D ^DIE ;Update the transmit bill record 83 . Q 84 ; 85 I IBBA D CKRES^IBCESRV2(IBBA) ;Update completely resubmitted flags 86 ; 87 I IBBA,(FUNC="P"!(IBNEW&'$G(NOCT))) D CTDOWN^IBCEM02(IBBA,1) ;If resubmitted in a new batch or printed, update old batch 88 ; 89 S IBTEXT(1)=" UPDATED BY: "_$$EXTERNAL^DILFD(361.02,.02,,+$G(DUZ)) 90 S IBTEXT(2)="ACTION USED: "_$S(FUNC="E":"BILL EDITED/RESUBMITTED",FUNC="C":"BILL CANCELED",FUNC="R":"BILL RESUBMITTED WITHOUT EDIT",FUNC="P":"PRINT BILL",FUNC="Z":"PROCESS COB",1:"") 91 S IBTEXT(2)=$S(IBTEXT(2)="":"UNSPECIFIED",1:IBTEXT(2)_" - REVIEW MARKED AS COMPLETE") 92 S IBTEXT=2 93 ; 94 ; Update file 361 95 S IBZ=0 F S IBZ=$O(^IBM(361,"AERR",+IBDA,IBZ)) Q:'IBZ I $D(^IBM(361,IBZ,0)),$P(^(0),U,10)="",$P(^(0),U,9)<2 D 96 . S DIE="^IBM(361,",DR=".09////2;.1////"_$TR(FUNC,"RCEIBZPN","RCROOFOO"),DA=IBZ D ^DIE 97 . I FUNC'="","ECRPIBZ"[FUNC D ; Update review status, notes for message 98 .. D NOTECHG^IBCECSA2(IBZ,1,.IBTEXT) 99 ; 100 ; Update file 361.1 with the Cancel Status, to cancel All EOB's on file 101 I FUNC="C" D STAT^IBCEMU2(IBIFN,9,0) 102 ; 103 Q 104 ; 105 DEL ; Delete messages from messages list - locked with IB SUPERVISOR key 106 N IBDA,IBOK,IBTDA,IBTYP,IBU,IBU1,IB0,DIR,IBT,IBE,Z,X,Y,XMSUBJ,XMTO,XMBODY,XMDUZ 107 D FULL^VALM1 108 S IBTDA=0 109 I '$D(^XUSEC("IB SUPERVISOR",DUZ)) D G DELQ 110 . W !,"You don't have authority to use this action. See your supervisr for assistance" 111 . D PAUSE^VALM1 112 D SEL(.IBDA,1) 113 S IBDA=$O(IBDA("")) 114 I IBDA="" G DELQ 115 W ! 116 S DIR(0)="YA",DIR("A",1)="This action will PERMANENTLY delete a return message from your system",DIR("A",2)="A bulletin will be sent to report the deletion",DIR("A",3)=" " 117 S DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE? ",DIR("B")="NO" 118 D ^DIR K DIR 119 G:Y'=1 DELQ 120 S IBTDA=+IBDA(IBDA) 121 I '$$LOCK(IBTDA) G DELQ 122 S IB0=$G(^IBA(364.2,IBTDA,0)) 123 ; 124 I $P(IB0,U,11) S IBOK=1 D G:'IBOK DELQ 125 . N ZTSK 126 . S ZTSK=$P(IB0,U,11) D STAT^%ZTLOAD Q:ZTSK(0)=0 ;Task not scheduled 127 . I "12"[ZTSK(1) W *7,!,"This message is currently scheduled for update. Task # is: ",$P(IB0,U,11) S IBOK="" D PAUSE^VALM1 128 ; 129 I $P(IB0,U,6)=""!("UP"'[$P(IB0,U,6)) D G DELQ 130 . W !,*7,"Message status ("_$$EXPAND^IBTRE(364.2,.06,$P(IB0,U,6))_") is not appropriate for this action" 131 . D PAUSE^VALM1 132 ; 133 S DIR(0)="YA",DIR("A",1)=" ",DIR("A",2)="",$P(DIR("A",2),"*",54)="",DIR("A",3)="* This message is about to be PERMANENTLY deleted!! *",DIR("A",4)=DIR("A",2),DIR("A",5)=" " 134 S DIR("A")="ARE YOU STILL SURE YOU WANT TO CONTINUE? ",DIR("B")="NO" 135 W ! D ^DIR W ! K DIR 136 I Y'=1 W !!,"Nothing deleted" D PAUSE^VALM1 G DELQ 137 ; 138 K ^TMP("IBMSG",$J) 139 M ^TMP("IBMSG",$J)=^IBA(364.2,IBTDA) 140 D DELMSG^IBCESRV2(IBTDA) 141 I $D(^IBA(364.2,IBTDA)) D G DELQ 142 . W !,"Message not deleted - problem with delete" D PAUSE^VALM1 143 ; 144 S IBT(1)="EDI return message #"_$P(IB0,U)_" has been deleted" 145 S IBT(2)=" " 146 S IBT(3)="DELETED BY: "_$P($G(^VA(200,+$G(DUZ),0)),U)_" "_$$FMTE^XLFDT($$NOW^XLFDT,2) 147 S Z=$$EXPAND^IBTRE(364.2,.06,$P(IB0,U,6)) S:Z="" Z="??" 148 S IBT(4)=" STATUS: "_$E(Z_$J("",11),1,11)_" MESSAGE TYPE: "_$P($G(^IBE(364.3,+$P(IB0,U,2),0)),U,5) 149 S IBT(5)=" MESSAGE #: "_$E($P(IB0,U)_$J("",11),1,11)_" STATUS DATE: "_$$FMTE^XLFDT($P($G(^TMP("IBMSG",$J,1)),U,3)) 150 S IBT(6)=" BATCH #: "_$E($P($G(^IBA(364.1,+$P(IB0,U,4),0)),U)_$J("",11),1,11)_" BILL #: "_$$EXPAND^IBTRE(364.2,.05,$P(IB0,U,5)) 151 S IBT(7)=" " 152 S IBT(8)="MESSAGE TEXT:",IBE=8 153 S Z=0 F S Z=$O(^TMP("IBMSG",$J,2,Z)) Q:'Z S IBE=IBE+1,IBT(IBE)=$G(^(Z,0)) 154 S XMSUBJ="EDI MESSAGE DELETED",XMBODY="IBT",XMDUZ="",XMTO("I:G.IB EDI")="" 155 D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,,.XMZ) 156 ; 157 K ^TMP("IBMSG",$J) 158 ; 159 W !,"A bulletin has been sent to report this deletion",! 160 D PAUSE^VALM1 161 ; 162 D BLD^IBCEM1 163 DELQ L -^IBA(364.2,IBTDA,0) 164 S VALMBCK="R" 165 Q 166 ; 167 TASK(IBRTN,IBBDA,IBTDA,IBTYP) ; Schedule the task to update data base from message 168 ; IBRTN = routine to task 169 ; IBBDA = batch # associated with the message (OPTIONAL) 170 ; IBTDA = internal entry of message 171 ; IBTYP = the number that is the last digit in the message type 172 ; 173 N ZTSK,ZTDESC,ZTIO,ZTDTH,ZTSAVE,DA,DR,DIE 174 S ZTIO="",ZTDTH=$H,ZTDESC="UPDATE DATA BASE FROM EDI RETURN MESSAGE",ZTSAVE("IB*")="",ZTRTN=IBRTN 175 D ^%ZTLOAD 176 I $G(ZTSK),$G(^IBA(364.2,IBTDA,0)) S DIE="^IBA(364.2,",DR=".11////"_ZTSK_";.06////U",DA=IBTDA D ^DIE 177 Q $G(ZTSK) 178 ; 179 LOCK(IBTDA) ; Attempt to lock message file entry IBTDA 180 ; Return 1 if successful, 0 if not able to lock 181 ; 182 N OK 183 S OK=1 184 L +^IBA(364.2,IBTDA,0):5 185 I '$T D 186 . I '$D(DIQUIET) W !,*7,"Another user is editing this entry ... try again later" D PAUSE^VALM1 187 . S IBDA="",OK=0 188 Q OK 189 ; 1 IBCEM ;ALB/TMP - 837 EDI RETURN MESSAGE PROCESSING ;17-APR-96 2 ;;2.0;INTEGRATED BILLING;**137,191,155**;21-MAR-94 3 Q 4 ; 5 UPD ; Update messages manually from messages list 6 N IBDA,IBOK,IBTDA,ZTSK,IBTSK,IBTYP,IBU,IBU1,IB0 7 D FULL^VALM1 8 D SEL(.IBDA,1) 9 S IBDA=$O(IBDA("")) 10 I IBDA="" G UPDQ 11 S IBTDA=+IBDA(IBDA) 12 I '$$LOCK(IBTDA) G UPDQ 13 S IB0=$G(^IBA(364.2,IBTDA,0)) 14 ; 15 I IB0="" D G UPDQ 16 . W !,*7,"Message ",IBDA," is no longer in return message file" S IBOK="" 17 . D PAUSE^VALM1 18 I $P(IB0,U,11) S IBOK=1 D G:'IBOK UPDQ 19 . N ZTSK 20 . S ZTSK=$P(IB0,U,11) D STAT^%ZTLOAD Q:ZTSK(0)=0 ;Task not scheduled 21 . I "12"[ZTSK(1) W *7,!,"This message has already been scheduled for update. Task # is: ",$P(IB0,U,11) S IBOK="" D PAUSE^VALM1 22 ; 23 I $P(IB0,U,6)=""!("UP"'[$P(IB0,U,6)) D G UPDQ 24 . W !,*7,"Message status ("_$$EXPAND^IBTRE(364.2,.06,$P(IB0,U,6))_") is not appropriate for this action" 25 . D PAUSE^VALM1 26 ; 27 S IBTYP=$P($G(^IBE(364.3,+$P(IB0,U,2),0)),U) 28 S IBU=$S(IBTYP="REPORT":"MAILIT^IBCESRV2",IBTYP["837REC":"CON837^IBCESRV2",IBTYP["837REJ":"REJ837^IBCESRV2",IBTYP["835EOB":"EOB835^IBCESRV3",1:""),IBU1=$S(IBTYP["837":$E(IBTYP,$L(IBTYP)),1:2) 29 I IBU="" W !,*7,"This message has an invalid message type - can't update" D PAUSE^VALM1 G UPDQ 30 S IBTSK=$$TASK(IBU,$P(IB0,U,4),IBTDA,IBU1) 31 I IBTSK W !,"Update has been tasked (#",IBTSK,")" 32 I 'IBTSK W !,*7,"Update could not be tasked. Please try again later!!!" 33 D PAUSE^VALM1 34 ; 35 D BLD^IBCEM1 36 UPDQ I $G(IBTDA) L -^IBA(364.2,IBTDA,0) 37 S VALMBCK="R" 38 Q 39 ; 40 VP ; View/Print Return Messages 41 N DHD,DIC,FLDS,BY,FR,TO,DIR,Y,L,IBDA,IBTDA,IBBILLS 42 D FULL^VALM1,SEL(.IBDA,1) 43 S IBDA=$O(IBDA("")) 44 G:'IBDA VPQ 45 S IBTDA=$G(IBDA(IBDA)),IBBILLS="" 46 I $P($G(^IBA(364.2,IBTDA,0)),U,4),'$P(^(0),U,5) D 47 .S DIR(0)="YA",DIR("B")="NO",DIR("A")="Do you want to list all bills for this batch?: " D ^DIR K DIR 48 .I Y S IBBILLS=1 49 S DHD=$S(IBBILLS:"[IBCEM MESSAGE LIST HDR]",1:""),DIC="^IBA(364.2,",FLDS=$S(IBBILLS:"[IBCEM MESSAGE LIST]",1:"[CAPTIONED]"),BY="@NUMBER",(FR,TO)=$G(IBDA(IBDA)),L=0 D EN1^DIP 50 D PAUSE^VALM1 51 VPQ S VALMBCK="R" 52 Q 53 ; 54 SEL(IBDA,ONE) ; Select entry(s) from list 55 ; IBDA = array returned if selections made 56 ; IBDA(n)=ien of bill selected in file 399 57 ; ONE = if set to 1, only one selection can be made at a time 58 N IB 59 K IBDA 60 D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S")) 61 S IBDA=0 F S IBDA=$O(VALMY(IBDA)) Q:'IBDA S IB=$G(^TMP("IBCEM-837DX",$J,IBDA)),IBDA(IBDA)=+$P(IB,U,2) 62 Q 63 ; 64 UPDEDI(IBDA,FUNC,NOCT) ; Update EDI files - cancel/resubmit/print as 65 ; resolution to message 66 ; IBDA = transmit bill ien # for bill 67 ; FUNC = "E" for edit/resubmit, "C" for cancel, "R" for resubmit not 68 ; from edit, "P" for print, "Z" for COB processed , "N" for no 69 ; further action needed-close record 70 ; NOCT = 1 if not necessary to update batch count, 0 if update needed 71 ; 72 N IB0,IBBA,IBBDA,IBCT,IBM,IBTDA,IBNEW,DA,DIE,DR,Z,IBTEXT,IBZ,IBIFN,IBSTAT 73 S IB0=$G(^IBA(364,+IBDA,0)),IBBA=$P(IB0,U,2) 74 Q:IB0="" S IBIFN=+IB0 75 ; 76 S IBNEW=$S(FUNC="E"!(FUNC="R"):+$P($G(^IBA(364,+$$LAST364^IBCEF4(+IB0),0)),U,2),1:"") S:IBNEW=IBBA IBNEW="" 77 ; 78 S IBSTAT=$P(IB0,U,3) ; current status in file 364 79 I '$F(".C.R.E.Z.","."_IBSTAT_".") D ; don't update if in final status 80 . S DR=".03////"_$S(FUNC="E":"R","NP"'[FUNC:FUNC,1:"Z")_";.04///NOW" S:FUNC="E"!(FUNC="R") DR=DR_$S(IBNEW:";.06////"_IBNEW,1:"") 81 . S DA=+IBDA,DIE="^IBA(364," D ^DIE ;Update the transmit bill record 82 . Q 83 ; 84 I IBBA D CKRES^IBCESRV2(IBBA) ;Update completely resubmitted flags 85 ; 86 I IBBA,(FUNC="P"!(IBNEW&'$G(NOCT))) D CTDOWN^IBCEM02(IBBA,1) ;If resubmitted in a new batch or printed, update old batch 87 ; 88 S IBTEXT(1)=" UPDATED BY: "_$$EXTERNAL^DILFD(361.02,.02,,+$G(DUZ)) 89 S IBTEXT(2)="ACTION USED: "_$S(FUNC="E":"BILL EDITED/RESUBMITTED",FUNC="C":"BILL CANCELED",FUNC="R":"BILL RESUBMITTED WITHOUT EDIT)",FUNC="P":"PRINT BILL",FUNC="Z":"PROCESS COB",1:"") 90 S IBTEXT(2)=$S(IBTEXT(2)="":"UNSPECIFIED",1:IBTEXT(2)_" - REVIEW MARKED AS COMPLETE") 91 S IBTEXT=2 92 ; 93 ; Update file 361 94 S IBZ=0 F S IBZ=$O(^IBM(361,"AERR",+IBDA,IBZ)) Q:'IBZ I $D(^IBM(361,IBZ,0)),$P(^(0),U,10)="",$P(^(0),U,9)<2 D 95 . S DIE="^IBM(361,",DR=".09////2;.1////"_$TR(FUNC,"RCEIBZPN","RCROOFOO"),DA=IBZ D ^DIE 96 . I FUNC'="","ECRPIBZ"[FUNC D ; Update review status, notes for message 97 .. D NOTECHG^IBCECSA2(IBZ,1,.IBTEXT) 98 ; 99 ; Update file 361.1 with the Cancel Status, to cancel All EOB's on file 100 I FUNC="C" D STAT^IBCEMU2(IBIFN,9,0) 101 ; 102 Q 103 ; 104 DEL ; Delete messages from messages list - locked with IB SUPERVISOR key 105 N IBDA,IBOK,IBTDA,IBTYP,IBU,IBU1,IB0,DIR,IBT,IBE,Z,X,Y,XMSUBJ,XMTO,XMBODY,XMDUZ 106 D FULL^VALM1 107 S IBTDA=0 108 I '$D(^XUSEC("IB SUPERVISOR",DUZ)) D G DELQ 109 . W !,"You don't have authority to use this action. See your supervisr for assistance" 110 . D PAUSE^VALM1 111 D SEL(.IBDA,1) 112 S IBDA=$O(IBDA("")) 113 I IBDA="" G DELQ 114 W ! 115 S DIR(0)="YA",DIR("A",1)="This action will PERMANENTLY delete a return message from your system",DIR("A",2)="A bulletin will be sent to report the deletion",DIR("A",3)=" " 116 S DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE? ",DIR("B")="NO" 117 D ^DIR K DIR 118 G:Y'=1 DELQ 119 S IBTDA=+IBDA(IBDA) 120 I '$$LOCK(IBTDA) G DELQ 121 S IB0=$G(^IBA(364.2,IBTDA,0)) 122 ; 123 I $P(IB0,U,11) S IBOK=1 D G:'IBOK DELQ 124 . N ZTSK 125 . S ZTSK=$P(IB0,U,11) D STAT^%ZTLOAD Q:ZTSK(0)=0 ;Task not scheduled 126 . I "12"[ZTSK(1) W *7,!,"This message is currently scheduled for update. Task # is: ",$P(IB0,U,11) S IBOK="" D PAUSE^VALM1 127 ; 128 I $P(IB0,U,6)=""!("UP"'[$P(IB0,U,6)) D G DELQ 129 . W !,*7,"Message status ("_$$EXPAND^IBTRE(364.2,.06,$P(IB0,U,6))_") is not appropriate for this action" 130 . D PAUSE^VALM1 131 ; 132 S DIR(0)="YA",DIR("A",1)=" ",DIR("A",2)="",$P(DIR("A",2),"*",54)="",DIR("A",3)="* This message is about to be PERMANENTLY deleted!! *",DIR("A",4)=DIR("A",2),DIR("A",5)=" " 133 S DIR("A")="ARE YOU STILL SURE YOU WANT TO CONTINUE? ",DIR("B")="NO" 134 W ! D ^DIR W ! K DIR 135 I Y'=1 W !!,"Nothing deleted" D PAUSE^VALM1 G DELQ 136 ; 137 K ^TMP("IBMSG",$J) 138 M ^TMP("IBMSG",$J)=^IBA(364.2,IBTDA) 139 D DELMSG^IBCESRV2(IBTDA) 140 I $D(^IBA(364.2,IBTDA)) D G DELQ 141 . W !,"Message not deleted - problem with delete" D PAUSE^VALM1 142 ; 143 S IBT(1)="EDI return message #"_$P(IB0,U)_" has been deleted" 144 S IBT(2)=" " 145 S IBT(3)="DELETED BY: "_$P($G(^VA(200,+$G(DUZ),0)),U)_" "_$$FMTE^XLFDT($$NOW^XLFDT,2) 146 S Z=$$EXPAND^IBTRE(364.2,.06,$P(IB0,U,6)) S:Z="" Z="??" 147 S IBT(4)=" STATUS: "_$E(Z_$J("",11),1,11)_" MESSAGE TYPE: "_$P($G(^IBE(364.3,+$P(IB0,U,2),0)),U,5) 148 S IBT(5)=" MESSAGE #: "_$E($P(IB0,U)_$J("",11),1,11)_" STATUS DATE: "_$$FMTE^XLFDT($P($G(^TMP("IBMSG",$J,1)),U,3)) 149 S IBT(6)=" BATCH #: "_$E($P($G(^IBA(364.1,+$P(IB0,U,4),0)),U)_$J("",11),1,11)_" BILL #: "_$$EXPAND^IBTRE(364.2,.05,$P(IB0,U,5)) 150 S IBT(7)=" " 151 S IBT(8)="MESSAGE TEXT:",IBE=8 152 S Z=0 F S Z=$O(^TMP("IBMSG",$J,2,Z)) Q:'Z S IBE=IBE+1,IBT(IBE)=$G(^(Z,0)) 153 S XMSUBJ="EDI MESSAGE DELETED",XMBODY="IBT",XMDUZ="",XMTO("I:G.IB EDI")="" 154 D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,,.XMZ) 155 ; 156 K ^TMP("IBMSG",$J) 157 ; 158 W !,"A bulletin has been sent to report this deletion",! 159 D PAUSE^VALM1 160 ; 161 D BLD^IBCEM1 162 DELQ L -^IBA(364.2,IBTDA,0) 163 S VALMBCK="R" 164 Q 165 ; 166 TASK(IBRTN,IBBDA,IBTDA,IBTYP) ; Schedule the task to update data base from message 167 ; IBRTN = routine to task 168 ; IBBDA = batch # associated with the message (OPTIONAL) 169 ; IBTDA = internal entry of message 170 ; IBTYP = the number that is the last digit in the message type 171 ; 172 N ZTSK,ZTDESC,ZTIO,ZTDTH,ZTSAVE,DA,DR,DIE 173 S ZTIO="",ZTDTH=$H,ZTDESC="UPDATE DATA BASE FROM EDI RETURN MESSAGE",ZTSAVE("IB*")="",ZTRTN=IBRTN 174 D ^%ZTLOAD 175 I $G(ZTSK),$G(^IBA(364.2,IBTDA,0)) S DIE="^IBA(364.2,",DR=".11////"_ZTSK_";.06////U",DA=IBTDA D ^DIE 176 Q $G(ZTSK) 177 ; 178 LOCK(IBTDA) ; Attempt to lock message file entry IBTDA 179 ; Return 1 if successful, 0 if not able to lock 180 ; 181 N OK 182 S OK=1 183 L +^IBA(364.2,IBTDA,0):5 184 I '$T D 185 . I '$D(DIQUIET) W !,*7,"Another user is editing this entry ... try again later" D PAUSE^VALM1 186 . S IBDA="",OK=0 187 Q OK 188 ;
Note:
See TracChangeset
for help on using the changeset viewer.
