- ACRFSAMT ;IHS/OIRM/DSD/AEF - SEARCH FOR PAYMENT BY AMOUNT [ 11/01/2001 9:44 AM ]
- ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
- ;
- ;This routine will loop through the 1166 Approvals for Payment
- ;file ^AFSLAFP global and find batches containing the specified
- ;payment amount. An optional date range can be included to narrow the
- ;search.
- ;
- ;
- EN ;----- MAIN ENTRY POINT
- ;
- N AMT,BEG,END
- D AMT(.AMT)
- Q:AMT=""
- D DATES(.BEG,.END)
- Q:'$G(BEG)
- Q:'$G(END)
- D SEARCH(AMT,BEG,END)
- Q
- AMT(AMT) ;----- PROMPT FOR DOLLAR AMOUNT
- ;
- N DIR,DIRUT,DTOUT,DUOUT,X,Y
- S AMT=""
- S DIR(0)="N^::2"
- S DIR("A")="Enter DOLLAR AMOUNT"
- D ^DIR
- Q:Y["^"
- Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
- S AMT=Y
- S AMT=$J(AMT,$L(AMT),2)
- Q
- DATES(BEG,END) ;
- ;----- PROMPT FOR BEGINNING AND ENDING DATES
- ;
- D ;
- N DIR,DIRUT,DTOUT,DUOUT,X,Y
- K BEG,END
- S DIR(0)="D^::E"
- S DIR("A")="Enter BEGINNING DATE"
- D ^DIR
- Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
- S BEG=Y
- S DIR("A")="Enter ENDING DATE"
- D ^DIR
- Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
- S END=Y
- I END<BEG D G D
- . W !?5,"ENDING DATE cannot be less than BEGINNING DATE",!
- Q
- SEARCH(AMT,BEG,END) ;
- ;----- SEARCH AFSLAFP GLOBAL BY EXPORT DATE AND AMOUNT
- ;
- I BEG="" S BEG=0
- I END="" S END=9999999
- F X=BEG:1:END D EXP(X,AMT)
- Q
- EXP(X,AMT) ;
- ;----- SEARCH AFSLAFP GLOBAL
- ;
- S D0=0
- F S D0=$O(^AFSLAFP("EXP",X,D0)) Q:'D0 D
- . S D1=0
- . F S D1=$O(^AFSLAFP("EXP",X,D0,D1)) Q:'D1 D
- . . S D2=0
- . . F S D2=$O(^AFSLAFP(D0,1,D1,1,D2)) Q:'D2 D
- . . . S DOL=$P($G(^AFSLAFP(D0,1,D1,1,D2,0)),U,11)
- . . . I +DOL=+AMT D DISP(D0,D1,D2)
- Q
- DISP(D0,D1,D2) ;
- ;----- DISPLAY DATA
- ;
- S BATCH=$P($G(^AFSLAFP(D0,1,D1,0)),U)
- S SCHNO=$P($G(^AFSLAFP(D0,1,D1,2)),U,6)
- S CERT=$P($G(^AFSLAFP(D0,1,D1,0)),U,5)
- S CERT=$E(CERT,4,5)_"/"_$E(CERT,6,7)_"/"_$E(CERT,2,3)
- S EXP=$P($G(^AFSLAFP(D0,1,D1,2)),U)
- S EXP=$E(EXP,4,5)_"/"_$E(EXP,6,7)_"/"_$E(EXP,2,3)
- S AMT=$P($G(^AFSLAFP(D0,1,D1,1,D2,0)),U,11)
- S AMT=$J(AMT,$L(AMT),2)
- W !
- W EXP
- W ?10,AMT
- W ?30,BATCH
- W ?40,SCHNO
- W ?55,CERT
- W ?65,EXP
- Q
- ACRFSAMT ;IHS/OIRM/DSD/AEF - SEARCH FOR PAYMENT BY AMOUNT [ 11/01/2001 9:44 AM ]
- +1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
- +2 ;
- +3 ;This routine will loop through the 1166 Approvals for Payment
- +4 ;file ^AFSLAFP global and find batches containing the specified
- +5 ;payment amount. An optional date range can be included to narrow the
- +6 ;search.
- +7 ;
- +8 ;
- EN ;----- MAIN ENTRY POINT
- +1 ;
- +2 NEW AMT,BEG,END
- +3 DO AMT(.AMT)
- +4 IF AMT=""
- QUIT
- +5 DO DATES(.BEG,.END)
- +6 IF '$GET(BEG)
- QUIT
- +7 IF '$GET(END)
- QUIT
- +8 DO SEARCH(AMT,BEG,END)
- +9 QUIT
- AMT(AMT) ;----- PROMPT FOR DOLLAR AMOUNT
- +1 ;
- +2 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
- +3 SET AMT=""
- +4 SET DIR(0)="N^::2"
- +5 SET DIR("A")="Enter DOLLAR AMOUNT"
- +6 DO ^DIR
- +7 IF Y["^"
- QUIT
- +8 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
- QUIT
- +9 SET AMT=Y
- +10 SET AMT=$JUSTIFY(AMT,$LENGTH(AMT),2)
- +11 QUIT
- DATES(BEG,END) ;
- +1 ;----- PROMPT FOR BEGINNING AND ENDING DATES
- +2 ;
- D ;
- +1 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
- +2 KILL BEG,END
- +3 SET DIR(0)="D^::E"
- +4 SET DIR("A")="Enter BEGINNING DATE"
- +5 DO ^DIR
- +6 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
- QUIT
- +7 SET BEG=Y
- +8 SET DIR("A")="Enter ENDING DATE"
- +9 DO ^DIR
- +10 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
- QUIT
- +11 SET END=Y
- +12 IF END<BEG
- Begin DoDot:1
- +13 WRITE !?5,"ENDING DATE cannot be less than BEGINNING DATE",!
- End DoDot:1
- GOTO D
- +14 QUIT
- SEARCH(AMT,BEG,END) ;
- +1 ;----- SEARCH AFSLAFP GLOBAL BY EXPORT DATE AND AMOUNT
- +2 ;
- +3 IF BEG=""
- SET BEG=0
- +4 IF END=""
- SET END=9999999
- +5 FOR X=BEG:1:END
- DO EXP(X,AMT)
- +6 QUIT
- EXP(X,AMT) ;
- +1 ;----- SEARCH AFSLAFP GLOBAL
- +2 ;
- +3 SET D0=0
- +4 FOR
- SET D0=$ORDER(^AFSLAFP("EXP",X,D0))
- IF 'D0
- QUIT
- Begin DoDot:1
- +5 SET D1=0
- +6 FOR
- SET D1=$ORDER(^AFSLAFP("EXP",X,D0,D1))
- IF 'D1
- QUIT
- Begin DoDot:2
- +7 SET D2=0
- +8 FOR
- SET D2=$ORDER(^AFSLAFP(D0,1,D1,1,D2))
- IF 'D2
- QUIT
- Begin DoDot:3
- +9 SET DOL=$PIECE($GET(^AFSLAFP(D0,1,D1,1,D2,0)),U,11)
- +10 IF +DOL=+AMT
- DO DISP(D0,D1,D2)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +11 QUIT
- DISP(D0,D1,D2) ;
- +1 ;----- DISPLAY DATA
- +2 ;
- +3 SET BATCH=$PIECE($GET(^AFSLAFP(D0,1,D1,0)),U)
- +4 SET SCHNO=$PIECE($GET(^AFSLAFP(D0,1,D1,2)),U,6)
- +5 SET CERT=$PIECE($GET(^AFSLAFP(D0,1,D1,0)),U,5)
- +6 SET CERT=$EXTRACT(CERT,4,5)_"/"_$EXTRACT(CERT,6,7)_"/"_$EXTRACT(CERT,2,3)
- +7 SET EXP=$PIECE($GET(^AFSLAFP(D0,1,D1,2)),U)
- +8 SET EXP=$EXTRACT(EXP,4,5)_"/"_$EXTRACT(EXP,6,7)_"/"_$EXTRACT(EXP,2,3)
- +9 SET AMT=$PIECE($GET(^AFSLAFP(D0,1,D1,1,D2,0)),U,11)
- +10 SET AMT=$JUSTIFY(AMT,$LENGTH(AMT),2)
- +11 WRITE !
- +12 WRITE EXP
- +13 WRITE ?10,AMT
- +14 WRITE ?30,BATCH
- +15 WRITE ?40,SCHNO
- +16 WRITE ?55,CERT
- +17 WRITE ?65,EXP
- +18 QUIT
