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
