BARUFER ; IHS/SD/TPF - UFMS ERROR RESOLUTION ; 10/24/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**3,7,8,23**;OCT 26, 2005
Q
;
LKUP ;EP - LOOK UP ERROR REPORTED BY UFMS
N SEARCH,TARGET,CHOICE,ITEM,MAX,LINE,ESC
D ERRHDR
S $P(LINE,"-",81)=""
K DIR,DIC,DIE,DR,DA
S DIR("?",1)="Enter an 'APPLY TO' value. This corresponds to the 3P invoice #,"
S DIR("?",2)="or Enter a partial 'APPLY TO' value,"
S DIR("?")="or enter a '*' to get a list of all 'APPLY TO' values on file"
S DIR("A")="Enter an 'APPLY TO' value: "
S DIR(0)="FO^1:20"
D ^DIR
Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!(Y="")
;
S TARGET=Y
K CHOICES
I Y="*" S SEARCH="",TARGET=""
E S SEARCH=TARGET-1
S (MAX,ESC,CHOICE)=0
F ITEM=1:1 S SEARCH=$O(^BARSESS(DUZ(2),"E",SEARCH)) Q:SEARCH=""!($E(SEARCH,1,$L(TARGET))'=TARGET)!(ESC)!(CHOICE) D ;MRS:BAR*1.8*8 HEAT739
.;F ITEM=1:1 S SEARCH=$O(^BARSESS(DUZ(2),"E",SEARCH)) Q:SEARCH=""!(ESC)!(CHOICE) D ;MRS:BAR*1.8*8 HEAT739
.S CHOICES(ITEM)=SEARCH
.S MAX=MAX+1
.W !,ITEM_". "_CHOICES(ITEM)
.I '(ITEM#10)!('$O(^BARSESS(DUZ(2),"E",SEARCH))) K DIR S DIR(0)="NO^1:"_MAX W ! D ^DIR Q:Y="" S ESC=$D(DIRUT)!$D(DTOUT)!$D(DUOUT) Q:ESC S CHOICE=CHOICES(+Y)
I '$D(CHOICES) W " ??" H 2 G LKUP
I ITEM=2,$D(CHOICES) D ARTRAN(CHOICES(1)) G LKUP
G:ESC!'(CHOICE) LKUP
D ARTRAN(CHOICE)
G LKUP
Q
;
ARTRAN(APPLYTO) ;EP - PULL TRANSACTION DATA
N TRDATE,EXDATE,BILL,BILLIEN,TPBIEN,TRANTYP,ADJCAT,ENTRYBY
S PAGE=0
D LKUPHDR(APPLYTO)
D TRDETAIL
S TRDATE="",ESC=0
F S TRDATE=$O(^BARSESS(DUZ(2),"E",APPLYTO,TRDATE)) Q:'TRDATE!(ESC) D
.S CREDIT=$$GET1^DIQ(90050.03,TRDATE_",",2)
.S DEBIT=$$GET1^DIQ(90050.03,TRDATE_",",3)
.S BILL=$$GET1^DIQ(90050.03,TRDATE_",",4)
.S BLLIEN=$$GET1^DIQ(90050.03,TRDATE_",",4,"I")
.S ENTRYBY=$$GET1^DIQ(90050.03,TRDATE_",",13,"E")
.S TPBIEN=$$GET1^DIQ(90050.01,BLLIEN_",",17,"I")
.S TRANTYP=$$GET1^DIQ(90050.03,TRDATE_",",101,"E")
.S ADJCAT=$$GET1^DIQ(90050.03,TRDATE_",",102,"E")
.S SESSID=$O(^BARSESS(DUZ(2),"E",APPLYTO,TRDATE,""))
.S UDUZ=$O(^BARSESS(DUZ(2),"E",APPLYTO,TRDATE,SESSID,""))
.W !,BILL
.S Y=TRDATE X ^DD("DD") S EXDATE=Y
.W ?18,EXDATE
.W ?50,SESSID
.;W ?65,$E($P($G(^VA(200,DUZ,0)),U),1,15) ;MRS;BAR*1.8*7
.W ?65,$E($P($G(^VA(200,UDUZ,0)),U),1,15) ;MRS;BAR*1.8*7
.W !?10,ENTRYBY
.W ?30,$J(CREDIT,10,2)
.W ?40,$J(DEBIT,10,2)
.W ?52,$E(TRANTYP,1,15)
.W ?70,$E(ADJCAT,1,10)
.I $Y>(IOSL-4) W ! K DIR S DIR(0)="E" D ^DIR S ESC=$D(DIRUT)!$D(DTOUT)!$D(DUOUT) Q:ESC D LKUPHDR(APPLYTO),TRDETAIL
.S DELSEND=$$GET1^DIQ(90057.110102,TRDATE_","_SESSID_","_UDUZ_",",.08,"E")
.I DELSEND'="" D
..W !?15,"FILE SENT IN DELAYED MODE:"
..W !?20,DELSEND
.;SESSION TRANSMISSION DATES
.S TRANSDT=0 ;TRANSMISSION DATE
.F CNT=1:1 S TRANSDT=$O(^BARSESS(DUZ(2),UDUZ,11,SESSID,21,TRANSDT)) Q:'TRANSDT!ESC D
..S IENS=TRANSDT_","_SESSID_","_UDUZ_","
..S EXTRANS=$$GET1^DIQ(90057.210101,IENS,.01,"E")
..W:CNT=1 !?15,"SESSION TRANSMISSION DATE: ",EXTRANS
..I $Y>(IOSL-4) W ! K DIR S DIR(0)="E" D ^DIR S ESC=$D(DIRUT)!$D(DTOUT)!$D(DUOUT) Q:ESC D TRANSHDR
..S FILENAME=$$GET1^DIQ(90057.210101,IENS,.02,"E")
..S BY=$$GET1^DIQ(90057.210101,IENS,.03,"E")
..W !?15,"IN FILE: ",FILENAME
..W !?15," BY: ",BY
Q:ESC
K DIR
S DIR(0)="E"
W !
D ^DIR
Q
;
LKUPHDR(APPLYTO) ;
N PARENT,SATELITE
W @IOF
S PAGE=$G(PAGE)+1
S X="VIEWING TRANSACTIONS ASSOCIATED WITH 'APPLY TO'"
S X=$J("",IOM-$L(X)\2-$X)_X
W !,X
W ?70,"PAGE ",PAGE
W !
W $$CJ^XLFSTR("FIELD OF "_APPLYTO,IOM)
S PARENT=$E(APPLYTO,1,6)
S SATELITE=$E(APPLYTO,7,12)
K DIC,DIR,DIE,DA,DR
S DIC="^AUTTLOC("
S D="CTOO"
S DIC(0)=""
S X=PARENT
D IX^DIC
I Y<0 D
.S D="C"
.S DIC(0)=""
.S X=PARENT
.D IX^DIC
I Y<0 S PARENTNM="CAN'T BE FOUND"
E S PARENTNM=$$GET1^DIQ(9999999.06,+Y_",",.01,"E")
K DIC,DIR,DIE,DA,DR
S DIC="^AUTTLOC("
S D="CTOO"
S DIC(0)=""
S X=SATELITE
D IX^DIC
I Y<0 D
.S D="C"
.S DIC(0)=""
.S X=SATELITE
.D IX^DIC
I Y<0 S SATNAME="CAN'T BE FOUND"
E S SATNAME=$$GET1^DIQ(9999999.06,+Y_",",.01,"E")
K DIC,DIR,DIE,DA,DR
W $$CJ^XLFSTR("PARENT: "_PARENTNM,IOM)
W $$CJ^XLFSTR("SATELLITE: "_SATNAME,IOM)
Q
;
TRDETAIL ;
W !!?3,"A/R BILL"
W ?18,"TRAN. DATE"
W ?50,"SESSION ID"
W ?65,"SENT BY"
W !?10,"ENTRY BY"
W ?35,"CREDIT"
W ?45,"DEBIT"
W ?52,"TRANTYPE"
W ?70,"ADJCAT"
W !,LINE
Q
;
ERRHDR ;EP - ERROR SCREEN HEADER
W @IOF
W !!,$$CJ^XLFSTR("TRANSACTION LOOKUP BY 'APPLY TO' FIELD",IOM)
W !
Q
;
TRANSHDR ;EP - TRANSMISSION HEADER
W @IOF
W !?15,"SESSION TRANSMISSION DATE: ",EXTRANS
Q
BARUFER ; IHS/SD/TPF - UFMS ERROR RESOLUTION ; 10/24/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,7,8,23**;OCT 26, 2005
+2 QUIT
+3 ;
LKUP ;EP - LOOK UP ERROR REPORTED BY UFMS
+1 NEW SEARCH,TARGET,CHOICE,ITEM,MAX,LINE,ESC
+2 DO ERRHDR
+3 SET $PIECE(LINE,"-",81)=""
+4 KILL DIR,DIC,DIE,DR,DA
+5 SET DIR("?",1)="Enter an 'APPLY TO' value. This corresponds to the 3P invoice #,"
+6 SET DIR("?",2)="or Enter a partial 'APPLY TO' value,"
+7 SET DIR("?")="or enter a '*' to get a list of all 'APPLY TO' values on file"
+8 SET DIR("A")="Enter an 'APPLY TO' value: "
+9 SET DIR(0)="FO^1:20"
+10 DO ^DIR
+11 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT
+12 ;
+13 SET TARGET=Y
+14 KILL CHOICES
+15 IF Y="*"
SET SEARCH=""
SET TARGET=""
+16 IF '$TEST
SET SEARCH=TARGET-1
+17 SET (MAX,ESC,CHOICE)=0
+18 ;MRS:BAR*1.8*8 HEAT739
FOR ITEM=1:1
SET SEARCH=$ORDER(^BARSESS(DUZ(2),"E",SEARCH))
IF SEARCH=""!($EXTRACT(SEARCH,1,$LENGTH(TARGET))'=TARGET)!(ESC)!(CHOICE)
QUIT
Begin DoDot:1
+19 ;F ITEM=1:1 S SEARCH=$O(^BARSESS(DUZ(2),"E",SEARCH)) Q:SEARCH=""!(ESC)!(CHOICE) D ;MRS:BAR*1.8*8 HEAT739
+20 SET CHOICES(ITEM)=SEARCH
+21 SET MAX=MAX+1
+22 WRITE !,ITEM_". "_CHOICES(ITEM)
+23 IF '(ITEM#10)!('$ORDER(^BARSESS(DUZ(2),"E",SEARCH)))
KILL DIR
SET DIR(0)="NO^1:"_MAX
WRITE !
DO ^DIR
IF Y=""
QUIT
SET ESC=$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
IF ESC
QUIT
SET CHOICE=CHOICES(+Y)
End DoDot:1
+24 IF '$DATA(CHOICES)
WRITE " ??"
HANG 2
GOTO LKUP
+25 IF ITEM=2
IF $DATA(CHOICES)
DO ARTRAN(CHOICES(1))
GOTO LKUP
+26 IF ESC!'(CHOICE)
GOTO LKUP
+27 DO ARTRAN(CHOICE)
+28 GOTO LKUP
+29 QUIT
+30 ;
ARTRAN(APPLYTO) ;EP - PULL TRANSACTION DATA
+1 NEW TRDATE,EXDATE,BILL,BILLIEN,TPBIEN,TRANTYP,ADJCAT,ENTRYBY
+2 SET PAGE=0
+3 DO LKUPHDR(APPLYTO)
+4 DO TRDETAIL
+5 SET TRDATE=""
SET ESC=0
+6 FOR
SET TRDATE=$ORDER(^BARSESS(DUZ(2),"E",APPLYTO,TRDATE))
IF 'TRDATE!(ESC)
QUIT
Begin DoDot:1
+7 SET CREDIT=$$GET1^DIQ(90050.03,TRDATE_",",2)
+8 SET DEBIT=$$GET1^DIQ(90050.03,TRDATE_",",3)
+9 SET BILL=$$GET1^DIQ(90050.03,TRDATE_",",4)
+10 SET BLLIEN=$$GET1^DIQ(90050.03,TRDATE_",",4,"I")
+11 SET ENTRYBY=$$GET1^DIQ(90050.03,TRDATE_",",13,"E")
+12 SET TPBIEN=$$GET1^DIQ(90050.01,BLLIEN_",",17,"I")
+13 SET TRANTYP=$$GET1^DIQ(90050.03,TRDATE_",",101,"E")
+14 SET ADJCAT=$$GET1^DIQ(90050.03,TRDATE_",",102,"E")
+15 SET SESSID=$ORDER(^BARSESS(DUZ(2),"E",APPLYTO,TRDATE,""))
+16 SET UDUZ=$ORDER(^BARSESS(DUZ(2),"E",APPLYTO,TRDATE,SESSID,""))
+17 WRITE !,BILL
+18 SET Y=TRDATE
XECUTE ^DD("DD")
SET EXDATE=Y
+19 WRITE ?18,EXDATE
+20 WRITE ?50,SESSID
+21 ;W ?65,$E($P($G(^VA(200,DUZ,0)),U),1,15) ;MRS;BAR*1.8*7
+22 ;MRS;BAR*1.8*7
WRITE ?65,$EXTRACT($PIECE($GET(^VA(200,UDUZ,0)),U),1,15)
+23 WRITE !?10,ENTRYBY
+24 WRITE ?30,$JUSTIFY(CREDIT,10,2)
+25 WRITE ?40,$JUSTIFY(DEBIT,10,2)
+26 WRITE ?52,$EXTRACT(TRANTYP,1,15)
+27 WRITE ?70,$EXTRACT(ADJCAT,1,10)
+28 IF $Y>(IOSL-4)
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
SET ESC=$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
IF ESC
QUIT
DO LKUPHDR(APPLYTO)
DO TRDETAIL
+29 SET DELSEND=$$GET1^DIQ(90057.110102,TRDATE_","_SESSID_","_UDUZ_",",.08,"E")
+30 IF DELSEND'=""
Begin DoDot:2
+31 WRITE !?15,"FILE SENT IN DELAYED MODE:"
+32 WRITE !?20,DELSEND
End DoDot:2
+33 ;SESSION TRANSMISSION DATES
+34 ;TRANSMISSION DATE
SET TRANSDT=0
+35 FOR CNT=1:1
SET TRANSDT=$ORDER(^BARSESS(DUZ(2),UDUZ,11,SESSID,21,TRANSDT))
IF 'TRANSDT!ESC
QUIT
Begin DoDot:2
+36 SET IENS=TRANSDT_","_SESSID_","_UDUZ_","
+37 SET EXTRANS=$$GET1^DIQ(90057.210101,IENS,.01,"E")
+38 IF CNT=1
WRITE !?15,"SESSION TRANSMISSION DATE: ",EXTRANS
+39 IF $Y>(IOSL-4)
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
SET ESC=$DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)
IF ESC
QUIT
DO TRANSHDR
+40 SET FILENAME=$$GET1^DIQ(90057.210101,IENS,.02,"E")
+41 SET BY=$$GET1^DIQ(90057.210101,IENS,.03,"E")
+42 WRITE !?15,"IN FILE: ",FILENAME
+43 WRITE !?15," BY: ",BY
End DoDot:2
End DoDot:1
+44 IF ESC
QUIT
+45 KILL DIR
+46 SET DIR(0)="E"
+47 WRITE !
+48 DO ^DIR
+49 QUIT
+50 ;
LKUPHDR(APPLYTO) ;
+1 NEW PARENT,SATELITE
+2 WRITE @IOF
+3 SET PAGE=$GET(PAGE)+1
+4 SET X="VIEWING TRANSACTIONS ASSOCIATED WITH 'APPLY TO'"
+5 SET X=$JUSTIFY("",IOM-$LENGTH(X)\2-$X)_X
+6 WRITE !,X
+7 WRITE ?70,"PAGE ",PAGE
+8 WRITE !
+9 WRITE $$CJ^XLFSTR("FIELD OF "_APPLYTO,IOM)
+10 SET PARENT=$EXTRACT(APPLYTO,1,6)
+11 SET SATELITE=$EXTRACT(APPLYTO,7,12)
+12 KILL DIC,DIR,DIE,DA,DR
+13 SET DIC="^AUTTLOC("
+14 SET D="CTOO"
+15 SET DIC(0)=""
+16 SET X=PARENT
+17 DO IX^DIC
+18 IF Y<0
Begin DoDot:1
+19 SET D="C"
+20 SET DIC(0)=""
+21 SET X=PARENT
+22 DO IX^DIC
End DoDot:1
+23 IF Y<0
SET PARENTNM="CAN'T BE FOUND"
+24 IF '$TEST
SET PARENTNM=$$GET1^DIQ(9999999.06,+Y_",",.01,"E")
+25 KILL DIC,DIR,DIE,DA,DR
+26 SET DIC="^AUTTLOC("
+27 SET D="CTOO"
+28 SET DIC(0)=""
+29 SET X=SATELITE
+30 DO IX^DIC
+31 IF Y<0
Begin DoDot:1
+32 SET D="C"
+33 SET DIC(0)=""
+34 SET X=SATELITE
+35 DO IX^DIC
End DoDot:1
+36 IF Y<0
SET SATNAME="CAN'T BE FOUND"
+37 IF '$TEST
SET SATNAME=$$GET1^DIQ(9999999.06,+Y_",",.01,"E")
+38 KILL DIC,DIR,DIE,DA,DR
+39 WRITE $$CJ^XLFSTR("PARENT: "_PARENTNM,IOM)
+40 WRITE $$CJ^XLFSTR("SATELLITE: "_SATNAME,IOM)
+41 QUIT
+42 ;
TRDETAIL ;
+1 WRITE !!?3,"A/R BILL"
+2 WRITE ?18,"TRAN. DATE"
+3 WRITE ?50,"SESSION ID"
+4 WRITE ?65,"SENT BY"
+5 WRITE !?10,"ENTRY BY"
+6 WRITE ?35,"CREDIT"
+7 WRITE ?45,"DEBIT"
+8 WRITE ?52,"TRANTYPE"
+9 WRITE ?70,"ADJCAT"
+10 WRITE !,LINE
+11 QUIT
+12 ;
ERRHDR ;EP - ERROR SCREEN HEADER
+1 WRITE @IOF
+2 WRITE !!,$$CJ^XLFSTR("TRANSACTION LOOKUP BY 'APPLY TO' FIELD",IOM)
+3 WRITE !
+4 QUIT
+5 ;
TRANSHDR ;EP - TRANSMISSION HEADER
+1 WRITE @IOF
+2 WRITE !?15,"SESSION TRANSMISSION DATE: ",EXTRANS
+3 QUIT
