- 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
