Routine: BARRQ2

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."

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")

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

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

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

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=""

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

BARRQ2.m