BARBLCN ; IHS/SD/LSL - CANCEL BILL ;
;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
;
; ITSC/SD/LSL - 10/18/02 - V1.7 - NOIS QAA-1200-130051
; Added quit logic if error getting new A/R Transaction although
; I'm not sure this feature even works correctly.
;
; ********************************************************************
ENP ; EP
; EN point for cancelling a bill from 3P
I '$D(^BARBL(DUZ(2),"B",X)) D Q
. W $$EN^BARVDF("IOF"),X_" Not in A/R System!"
;
; -------------------------------
SRCHTRNS ;
; Search the ^BARTR global for 49 type of transaction record for this A/R bill
S (BARDTTM,BARBLDA)=0
S BARUNDO=1
K BARBIL
S BARBLDA=$O(^BARBL(DUZ(2),"B",X,0))
F S BARDTTM=$O(^BARTR(DUZ(2),"AC",BARBLDA,BARDTTM)) Q:BARDTTM'>0 D
. I '$D(^BARTR(DUZ(2),BARDTTM,0)) Q
. I '$D(^BARTR(DUZ(2),BARDTTM,1)) Q
. I $P(^BARTR(DUZ(2),BARDTTM,1),"^")=49 D Q
.. D REVERSE
. Q
I BARTRIEN<1 Q
S BARBLST="143"
S DA=BARBLDA
S (DIC,DIE)=$$DIC^XBDIQ1(90050.01)
S DR="16////^S X=BARBLST"
S DIDEL=90050
D ^DIE
K DIDEL
Q
; *********************************************************************
;
REVERSE ;
; Create transaction records to reverse out the transaction records when 3P cancels a bill
N BARX,BARCR,BARDB,BARTT,BARCAT,BARATYP,BARBDFN,BARPT,BARAC,BARPAR
N BARASFAC,BARSECT,BARSITE,BARTYPE
S BARTRIEN=$$NEW^BARTR
I BARTRIEN<1 D MSG^BARTR(BARBLDA) Q
K DIE,DIC,DR,DA
S (DA,BARTRDA)=X
S DIE=90050.03
S BARX=^BARTR(DUZ(2),BARDTTM,0)
S (BARCR,BARDB)=0
S:$P(BARX,"^",2)'=0 BARCR=$P(BARX,"^",2)
S:$P(BARX,"^",3)'=0 BARDB=$P(BARX,"^",3)
S BARTT=41
S BARCAT=3
S BARATYP=135
S BARBDFN=$P(BARX,U,4)
S BARPT=$P(BARX,U,5)
S BARAC=$P(BARX,U,6)
S BARPAR=$P(BARX,U,8)
S BARASFAC=$P(BARX,U,9)
S BARSECT=$P(BARX,U,10)
S BARSITE=$P(BARX,U,11)
S BARTYPE=$P(BARX,U,16)
S DR=""
F I=1:1 S J=$T(TXT+I) Q:J="" D
. S DR=DR_$P(J,"~",2)_";"
. Q
S DIDEL=90050
D ^DIE
K DIDEL
D TR^BARTDO(BARTRDA,BARUNDO)
;
EXIT Q
TXT ;
;;~2////^S X=BARCR
;;~3////^S X=BARDB
;;~4////^S X=BARBDFN
;;~5////^S X=BARPT
;;~6////^S X=BARAC
;;~8////^S X=BARPAR
;;~9////^S X=BARASFAC
;;~10////^S X=BARSECT
;;~11////^S X=BARSITE
;;~12////^S X=DT
;;~13////^S X=DUZ
;;~16////^S X=BARTYPE
;;~101////^S X=BARTT
;;~102////^S X=BARCAT
;;~103////^S X=BARATYP
Q
BARBLCN ; IHS/SD/LSL - CANCEL BILL ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
+2 ;
+3 ; ITSC/SD/LSL - 10/18/02 - V1.7 - NOIS QAA-1200-130051
+4 ; Added quit logic if error getting new A/R Transaction although
+5 ; I'm not sure this feature even works correctly.
+6 ;
+7 ; ********************************************************************
ENP ; EP
+1 ; EN point for cancelling a bill from 3P
+2 IF '$DATA(^BARBL(DUZ(2),"B",X))
Begin DoDot:1
+3 WRITE $$EN^BARVDF("IOF"),X_" Not in A/R System!"
End DoDot:1
QUIT
+4 ;
+5 ; -------------------------------
SRCHTRNS ;
+1 ; Search the ^BARTR global for 49 type of transaction record for this A/R bill
+2 SET (BARDTTM,BARBLDA)=0
+3 SET BARUNDO=1
+4 KILL BARBIL
+5 SET BARBLDA=$ORDER(^BARBL(DUZ(2),"B",X,0))
+6 FOR
SET BARDTTM=$ORDER(^BARTR(DUZ(2),"AC",BARBLDA,BARDTTM))
IF BARDTTM'>0
QUIT
Begin DoDot:1
+7 IF '$DATA(^BARTR(DUZ(2),BARDTTM,0))
QUIT
+8 IF '$DATA(^BARTR(DUZ(2),BARDTTM,1))
QUIT
+9 IF $PIECE(^BARTR(DUZ(2),BARDTTM,1),"^")=49
Begin DoDot:2
+10 DO REVERSE
End DoDot:2
QUIT
+11 QUIT
End DoDot:1
+12 IF BARTRIEN<1
QUIT
+13 SET BARBLST="143"
+14 SET DA=BARBLDA
+15 SET (DIC,DIE)=$$DIC^XBDIQ1(90050.01)
+16 SET DR="16////^S X=BARBLST"
+17 SET DIDEL=90050
+18 DO ^DIE
+19 KILL DIDEL
+20 QUIT
+21 ; *********************************************************************
+22 ;
REVERSE ;
+1 ; Create transaction records to reverse out the transaction records when 3P cancels a bill
+2 NEW BARX,BARCR,BARDB,BARTT,BARCAT,BARATYP,BARBDFN,BARPT,BARAC,BARPAR
+3 NEW BARASFAC,BARSECT,BARSITE,BARTYPE
+4 SET BARTRIEN=$$NEW^BARTR
+5 IF BARTRIEN<1
DO MSG^BARTR(BARBLDA)
QUIT
+6 KILL DIE,DIC,DR,DA
+7 SET (DA,BARTRDA)=X
+8 SET DIE=90050.03
+9 SET BARX=^BARTR(DUZ(2),BARDTTM,0)
+10 SET (BARCR,BARDB)=0
+11 IF $PIECE(BARX,"^",2)'=0
SET BARCR=$PIECE(BARX,"^",2)
+12 IF $PIECE(BARX,"^",3)'=0
SET BARDB=$PIECE(BARX,"^",3)
+13 SET BARTT=41
+14 SET BARCAT=3
+15 SET BARATYP=135
+16 SET BARBDFN=$PIECE(BARX,U,4)
+17 SET BARPT=$PIECE(BARX,U,5)
+18 SET BARAC=$PIECE(BARX,U,6)
+19 SET BARPAR=$PIECE(BARX,U,8)
+20 SET BARASFAC=$PIECE(BARX,U,9)
+21 SET BARSECT=$PIECE(BARX,U,10)
+22 SET BARSITE=$PIECE(BARX,U,11)
+23 SET BARTYPE=$PIECE(BARX,U,16)
+24 SET DR=""
+25 FOR I=1:1
SET J=$TEXT(TXT+I)
IF J=""
QUIT
Begin DoDot:1
+26 SET DR=DR_$PIECE(J,"~",2)_";"
+27 QUIT
End DoDot:1
+28 SET DIDEL=90050
+29 DO ^DIE
+30 KILL DIDEL
+31 DO TR^BARTDO(BARTRDA,BARUNDO)
+32 ;
EXIT QUIT
TXT ;
+1 ;;~2////^S X=BARCR
+2 ;;~3////^S X=BARDB
+3 ;;~4////^S X=BARBDFN
+4 ;;~5////^S X=BARPT
+5 ;;~6////^S X=BARAC
+6 ;;~8////^S X=BARPAR
+7 ;;~9////^S X=BARASFAC
+8 ;;~10////^S X=BARSECT
+9 ;;~11////^S X=BARSITE
+10 ;;~12////^S X=DT
+11 ;;~13////^S X=DUZ
+12 ;;~16////^S X=BARTYPE
+13 ;;~101////^S X=BARTT
+14 ;;~102////^S X=BARCAT
+15 ;;~103////^S X=BARATYP
+16 QUIT
