- 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
