BARFM ; IHS/SD/LSL - USER FM ACCESS TO RESTRICTED FILES MAY 30,1996 ;
;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
;;
; IHS/SD/LSL - 06/23/03 - V1.7 Patch 2
; Modified screen to work better with FM 22
;
; IHS/SD/LSL - 09/22/03 - V1.7 Patch 4 - IM11534
; Resolve <CMMND>*XECUTE*S^DIC1
Q
; *********************************************************************
;
EN ; EP
; FM search or sort files
SELPKG ;
; select package / select file withing package return file number in BARFN
S BARFN=0
I '$D(DUZ(2)) D Q
. W !,"DUZ(2) NOT DEFINED",!
. D EOP^BARUTL(0)
D SPKG
K DIC,DA,DR,DIE
S DIC=9.4
S DIC(0)="AEQM"
S DIC("S")="I $S($$GET1^DIQ(9.4,+Y,1)']"""":0,1:$D(BARS($$GET1^DIQ(9.4,+Y,1))))"
D ^DIC
Q:Y'>0
S BARPKDA=+Y
S BARNS=$$VAL^XBDIQ1(9.4,+Y,1)
; -------------------------------
;
SELFILE ;
; select file
K DIC,DA,DR,DIE
S DIC=$$DIC^XBDIQ1(9.44),DIC(0)="AQEMZ"
S DA(1)=BARPKDA
I $L($T(@BARNS)) D
.K BARS
.F I=1:1 S X=$P($T(@BARNS+I),";;",2) Q:X="end" S BARS(X)=""
.S DIC("S")="N Z S Z=$P(^(0),U) I $D(BARS(Z))"
D ^DIC
Q:Y'>0
S DA=+Y
S BARFN=$$VALI^XBDIQ1(DIC,.DA,.01)
Q
; *********************************************************************
;
SPKG ;
K BARS
F I=1:1 S X=$P($T(PKG+I),";;",2) Q:X="end" S BARS(X)=""
Q
; *********************************************************************
;
DIP ; EP
; do a sort/print of a file
D EN^BARFM
Q:'$G(BARFN)
S DIC=BARFN
I BARFN=90050.03 D
. W !,"You have selected the A/R Transaction file",!
. K DIR
. W !,"Would you like an auto screen for:"
. W !," 'payments,refunds, & adjustments' set ? ",!
. S DIR(0)="YO"
. S DIR("B")="Y"
. D ^DIR
. K DIR
. I 'Y W !,"Screen not set",! Q
. S DIS(0)="N X S X=$P($G(^BARTR(DUZ(2),D0,1)),U) I ((X=40)!(X=39)!(X=43))"
. W !,"Screen is set",!
D EN1^DIP
Q
; *********************************************************************
;
DIS ; EP
; do a SEARCH/PRINT of a file
D EN^BARFM
Q:'$G(BARFN)
S DIC=BARFN
D EN^DIS
Q
; *********************************************************************
;
XBFLD ; EP
; do a quick dd file print
D ^XBFLD
Q
; *********************************************************************
;
;----------- ARRAY BUILDING
PKG ;;list of name spaces
;;BAR
;;ABM
;;AG
;;end
BAR ;; list of BAR FILES
;;90051.01;; collection batch
;;90050.02;; account
;;90050.01;; bill
;;90050.03;; transaction
;;end
BARFM ; IHS/SD/LSL - USER FM ACCESS TO RESTRICTED FILES MAY 30,1996 ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
+2 ;;
+3 ; IHS/SD/LSL - 06/23/03 - V1.7 Patch 2
+4 ; Modified screen to work better with FM 22
+5 ;
+6 ; IHS/SD/LSL - 09/22/03 - V1.7 Patch 4 - IM11534
+7 ; Resolve <CMMND>*XECUTE*S^DIC1
+8 QUIT
+9 ; *********************************************************************
+10 ;
EN ; EP
+1 ; FM search or sort files
SELPKG ;
+1 ; select package / select file withing package return file number in BARFN
+2 SET BARFN=0
+3 IF '$DATA(DUZ(2))
Begin DoDot:1
+4 WRITE !,"DUZ(2) NOT DEFINED",!
+5 DO EOP^BARUTL(0)
End DoDot:1
QUIT
+6 DO SPKG
+7 KILL DIC,DA,DR,DIE
+8 SET DIC=9.4
+9 SET DIC(0)="AEQM"
+10 SET DIC("S")="I $S($$GET1^DIQ(9.4,+Y,1)']"""":0,1:$D(BARS($$GET1^DIQ(9.4,+Y,1))))"
+11 DO ^DIC
+12 IF Y'>0
QUIT
+13 SET BARPKDA=+Y
+14 SET BARNS=$$VAL^XBDIQ1(9.4,+Y,1)
+15 ; -------------------------------
+16 ;
SELFILE ;
+1 ; select file
+2 KILL DIC,DA,DR,DIE
+3 SET DIC=$$DIC^XBDIQ1(9.44)
SET DIC(0)="AQEMZ"
+4 SET DA(1)=BARPKDA
+5 IF $LENGTH($TEXT(@BARNS))
Begin DoDot:1
+6 KILL BARS
+7 FOR I=1:1
SET X=$PIECE($TEXT(@BARNS+I),";;",2)
IF X="end"
QUIT
SET BARS(X)=""
+8 SET DIC("S")="N Z S Z=$P(^(0),U) I $D(BARS(Z))"
End DoDot:1
+9 DO ^DIC
+10 IF Y'>0
QUIT
+11 SET DA=+Y
+12 SET BARFN=$$VALI^XBDIQ1(DIC,.DA,.01)
+13 QUIT
+14 ; *********************************************************************
+15 ;
SPKG ;
+1 KILL BARS
+2 FOR I=1:1
SET X=$PIECE($TEXT(PKG+I),";;",2)
IF X="end"
QUIT
SET BARS(X)=""
+3 QUIT
+4 ; *********************************************************************
+5 ;
DIP ; EP
+1 ; do a sort/print of a file
+2 DO EN^BARFM
+3 IF '$GET(BARFN)
QUIT
+4 SET DIC=BARFN
+5 IF BARFN=90050.03
Begin DoDot:1
+6 WRITE !,"You have selected the A/R Transaction file",!
+7 KILL DIR
+8 WRITE !,"Would you like an auto screen for:"
+9 WRITE !," 'payments,refunds, & adjustments' set ? ",!
+10 SET DIR(0)="YO"
+11 SET DIR("B")="Y"
+12 DO ^DIR
+13 KILL DIR
+14 IF 'Y
WRITE !,"Screen not set",!
QUIT
+15 SET DIS(0)="N X S X=$P($G(^BARTR(DUZ(2),D0,1)),U) I ((X=40)!(X=39)!(X=43))"
+16 WRITE !,"Screen is set",!
End DoDot:1
+17 DO EN1^DIP
+18 QUIT
+19 ; *********************************************************************
+20 ;
DIS ; EP
+1 ; do a SEARCH/PRINT of a file
+2 DO EN^BARFM
+3 IF '$GET(BARFN)
QUIT
+4 SET DIC=BARFN
+5 DO EN^DIS
+6 QUIT
+7 ; *********************************************************************
+8 ;
XBFLD ; EP
+1 ; do a quick dd file print
+2 DO ^XBFLD
+3 QUIT
+4 ; *********************************************************************
+5 ;
+6 ;----------- ARRAY BUILDING
PKG ;;list of name spaces
+1 ;;BAR
+2 ;;ABM
+3 ;;AG
+4 ;;end
BAR ;; list of BAR FILES
+1 ;;90051.01;; collection batch
+2 ;;90050.02;; account
+3 ;;90050.01;; bill
+4 ;;90050.03;; transaction
+5 ;;end
