BARRQ2 ; IHS/SD/TPF - Re-queue A/R Transactions for UFMS export ;
;;1.8;IHS ACCOUNTS RECEIVABLE;**22**;OCT 26,2005;Build 38
MSG ;EP
W !!,"This option should only be run by OIT!"
W !,"The user will be given a variety of ways to requeue A/R Transactions"
W !,"to go to UFMS. This should be done with EXTREME caution, as erroneous"
W !,"or duplication of transaction will cause errors at UFMS."
W !,"PLEASE contact OIT if you have any questions."
Q
INDPAT(BARTRIEN) ;EP - IS BEN OR NO INS TYP
S BARTR0=$G(^BARTR(DUZ(2),BARTRIEN,0))
S BARBL=$P(BARTR0,U,4)
I BARBL="" D Q 1
.W !,"NO BILL FOUND FOR THIS TX!"
S BAR(0)=$G(^BARBL(DUZ(2),BARBL,0))
S BARAC=$P(BAR(0),U,3) ;A/R Account IEN
S BARITYP=$$GET1^DIQ(90050.02,BARAC,1.08) ;Ins Typ
Q BARITYP=""!(BARITYP="INDIAN PATIENT")
Q
;
RESEND(UDUZ,SESSID,BARTRIEN) ;EP - ADD TO NEW CASHIER SESS
;COPY EXISTING DAT INTO TMP
I SESSID'="",UDUZ'="" D
.S ^TMP($J,BARRNAM,BARRQDT,20,"BARSESS",BARTRIEN,SESSID,110102,1)=UDUZ
.S ^TMP($J,BARRNAM,BARRQDT,20,"BARSESS",BARTRIEN,SESSID,110102,2)=$G(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,BARTRIEN,0))
.S ^TMP($J,BARRNAM,BARRQDT,20,"BARSESS",BARTRIEN,SESSID,210101)=$G(^BARSESS(DUZ(2),UDUZ,21,SESSID,2,1,0))
.S ^TMP($J,BARRNAM,BARRQDT,20,"BARSESS",BARTRIEN,SESSID,6)=$G(^BARTR(DUZ(2),BARTRIEN,6))
Q
;
CLRSESS ;CLEAR THE SESS TRANSMISSION DATA
D SAVE^BARRQ1 ;SAVE ORIGINAL DATA BEFORE RE-Q
I $D(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,BARTRIEN)) D
.Q:'UDUZ
.Q:'SESSID
.K DIR,DIE,DIC,DA,DR
.S DA(2)=UDUZ
.S DA(1)=SESSID
.S DA=BARTRIEN
.S DIE="^BARSESS(DUZ(2),"_DA(2)_",11,"_DA(1)_",2,"
.S DR=".04///@;.05////@;.06///@"
.D ^DIE
.K DIR,DIE,DIC,DA,DR
Q
;
CLEARTX ;EP - CLEAR THE A/R TRANS TRANSMISSION DATA
I $G(BARSAVE)'=1 D SAVE^BARRQ1
I $D(^BARTR(DUZ(2),BARTRIEN,6)) D
.S DA=BARTRIEN
.S DIE="^BARTR(DUZ(2),"
.S DR="601///@;602////@;603///@;604///@"
.D ^DIE
.K DIR,DIE,DIC,DA,DR
Q
SESSLOG ;EP - ADD TX DATA TO NEW/OPEN CASHIER SESS
;CHECK FOR ALL REQ'D DATA THEN CALL TRANTRIG!
S X=$$TRANTRIG^BARUFUT(NEWDUZ,NEWSESS,BARTRIEN)
S FLAG=1
S BARBLIEN=$P($G(^BARTR(DUZ(2),BARTRIEN,0)),U,4) ;A/R BILL IEN
S:BARBLIEN BARBILL=$P($G(^BARBL(DUZ(2),BARBLIEN,0)),U) ;A/R BILL
S BARCNTS=BARCNTS+1 ;CNT TX ADDED TO SESS
S BARMSG2=""
S BARMSG1=BARTRIEN_" RE-QUEUED IN CASHIER SESSION: "_NEWSESS_" FOR USER: "_$G(NEWUSRNM)
I $G(SESSXMT)'["TRANSMIT" S BARMSG2="*** NOTE: ORIG SESS STATUS NOT TRANSMITTED ***"
W !,DASHLINE
W !,$G(BARCNTS),?6,$G(BARMSG1),!,?6,$G(BARMSG2)
W !,?5,"A/R TRANS:",?25,$G(BARTRIEN),?45,"ORIGINAL SESSION:",?65,$G(SESSID)
W !,?5,"A/R BILL:",?25,$G(BARBILL),?45,"ORIG EXPORT USER:"
W:$G(UDUZ)'="" ?65,$P($G(^VA(200,UDUZ,0)),U)
W !,?5,"3P BILL:",?25,$G(TPBILL)
I $G(BAR3PB)=1 W !,?6,"# OF A/R TX'S PROCESSED FOR ",$G(TPBILL),":",?37,BARCNT3X
S BARSAVE=""
Q
BARRQ2 ; IHS/SD/TPF - Re-queue A/R Transactions for UFMS export ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**22**;OCT 26,2005;Build 38
MSG ;EP
+1 WRITE !!,"This option should only be run by OIT!"
+2 WRITE !,"The user will be given a variety of ways to requeue A/R Transactions"
+3 WRITE !,"to go to UFMS. This should be done with EXTREME caution, as erroneous"
+4 WRITE !,"or duplication of transaction will cause errors at UFMS."
+5 WRITE !,"PLEASE contact OIT if you have any questions."
+6 QUIT
INDPAT(BARTRIEN) ;EP - IS BEN OR NO INS TYP
+1 SET BARTR0=$GET(^BARTR(DUZ(2),BARTRIEN,0))
+2 SET BARBL=$PIECE(BARTR0,U,4)
+3 IF BARBL=""
Begin DoDot:1
+4 WRITE !,"NO BILL FOUND FOR THIS TX!"
End DoDot:1
QUIT 1
+5 SET BAR(0)=$GET(^BARBL(DUZ(2),BARBL,0))
+6 ;A/R Account IEN
SET BARAC=$PIECE(BAR(0),U,3)
+7 ;Ins Typ
SET BARITYP=$$GET1^DIQ(90050.02,BARAC,1.08)
+8 QUIT BARITYP=""!(BARITYP="INDIAN PATIENT")
+9 QUIT
+10 ;
RESEND(UDUZ,SESSID,BARTRIEN) ;EP - ADD TO NEW CASHIER SESS
+1 ;COPY EXISTING DAT INTO TMP
+2 IF SESSID'=""
IF UDUZ'=""
Begin DoDot:1
+3 SET ^TMP($JOB,BARRNAM,BARRQDT,20,"BARSESS",BARTRIEN,SESSID,110102,1)=UDUZ
+4 SET ^TMP($JOB,BARRNAM,BARRQDT,20,"BARSESS",BARTRIEN,SESSID,110102,2)=$GET(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,BARTRIEN,0))
+5 SET ^TMP($JOB,BARRNAM,BARRQDT,20,"BARSESS",BARTRIEN,SESSID,210101)=$GET(^BARSESS(DUZ(2),UDUZ,21,SESSID,2,1,0))
+6 SET ^TMP($JOB,BARRNAM,BARRQDT,20,"BARSESS",BARTRIEN,SESSID,6)=$GET(^BARTR(DUZ(2),BARTRIEN,6))
End DoDot:1
+7 QUIT
+8 ;
CLRSESS ;CLEAR THE SESS TRANSMISSION DATA
+1 ;SAVE ORIGINAL DATA BEFORE RE-Q
DO SAVE^BARRQ1
+2 IF $DATA(^BARSESS(DUZ(2),UDUZ,11,SESSID,2,BARTRIEN))
Begin DoDot:1
+3 IF 'UDUZ
QUIT
+4 IF 'SESSID
QUIT
+5 KILL DIR,DIE,DIC,DA,DR
+6 SET DA(2)=UDUZ
+7 SET DA(1)=SESSID
+8 SET DA=BARTRIEN
+9 SET DIE="^BARSESS(DUZ(2),"_DA(2)_",11,"_DA(1)_",2,"
+10 SET DR=".04///@;.05////@;.06///@"
+11 DO ^DIE
+12 KILL DIR,DIE,DIC,DA,DR
End DoDot:1
+13 QUIT
+14 ;
CLEARTX ;EP - CLEAR THE A/R TRANS TRANSMISSION DATA
+1 IF $GET(BARSAVE)'=1
DO SAVE^BARRQ1
+2 IF $DATA(^BARTR(DUZ(2),BARTRIEN,6))
Begin DoDot:1
+3 SET DA=BARTRIEN
+4 SET DIE="^BARTR(DUZ(2),"
+5 SET DR="601///@;602////@;603///@;604///@"
+6 DO ^DIE
+7 KILL DIR,DIE,DIC,DA,DR
End DoDot:1
+8 QUIT
SESSLOG ;EP - ADD TX DATA TO NEW/OPEN CASHIER SESS
+1 ;CHECK FOR ALL REQ'D DATA THEN CALL TRANTRIG!
+2 SET X=$$TRANTRIG^BARUFUT(NEWDUZ,NEWSESS,BARTRIEN)
+3 SET FLAG=1
+4 ;A/R BILL IEN
SET BARBLIEN=$PIECE($GET(^BARTR(DUZ(2),BARTRIEN,0)),U,4)
+5 ;A/R BILL
IF BARBLIEN
SET BARBILL=$PIECE($GET(^BARBL(DUZ(2),BARBLIEN,0)),U)
+6 ;CNT TX ADDED TO SESS
SET BARCNTS=BARCNTS+1
+7 SET BARMSG2=""
+8 SET BARMSG1=BARTRIEN_" RE-QUEUED IN CASHIER SESSION: "_NEWSESS_" FOR USER: "_$GET(NEWUSRNM)
+9 IF $GET(SESSXMT)'["TRANSMIT"
SET BARMSG2="*** NOTE: ORIG SESS STATUS NOT TRANSMITTED ***"
+10 WRITE !,DASHLINE
+11 WRITE !,$GET(BARCNTS),?6,$GET(BARMSG1),!,?6,$GET(BARMSG2)
+12 WRITE !,?5,"A/R TRANS:",?25,$GET(BARTRIEN),?45,"ORIGINAL SESSION:",?65,$GET(SESSID)
+13 WRITE !,?5,"A/R BILL:",?25,$GET(BARBILL),?45,"ORIG EXPORT USER:"
+14 IF $GET(UDUZ)'=""
WRITE ?65,$PIECE($GET(^VA(200,UDUZ,0)),U)
+15 WRITE !,?5,"3P BILL:",?25,$GET(TPBILL)
+16 IF $GET(BAR3PB)=1
WRITE !,?6,"# OF A/R TX'S PROCESSED FOR ",$GET(TPBILL),":",?37,BARCNT3X
+17 SET BARSAVE=""
+18 QUIT
