- PRCH2A ;WISC/PLT-DAILY PURCHASE CARD CHARGES STATEMENT ; 6/28/99 3:18pm
- V ;;5.1;IFCAP;**8,125**;Oct 20, 2000;Build 15
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- QUIT ;invalid entry
- ;
- EN ;print daily purchase card charges statement
- N PRCA,PRCB,PRCDATE,PRCDATEF,PRCDATEE,PRCDUZ,PRCNAME
- N A,B,C
- S PRCDUZ=DUZ
- Q1 ;statement from date
- S A=$$DATE^PRC0C($H-2,"H") D DT^PRC0A(.X,.Y,"For Credit Card Charge Statement Beginning Date: ","AO",$P(A,"^",4)_"/"_$P(A,"^",5)_"/"_$E($P(A,"^",3),3,4))
- I X["^"!(X="") G EXIT
- I $E(Y,6,7)<1 D EN^DDIOL("Date missing! Enter date format: MM/DD/YY") G Q1
- S PRCDATEF=Y
- Q2 ;statement ending date
- S A=$$DATE^PRC0C(PRCDATEF,"I") D DT^PRC0A(.X,.Y,"For Credit Card Charge Statement Ending Date: ","AO",$P(A,"^",4)_"/"_$P(A,"^",5)_"/"_$E($P(A,"^",3),3,4))
- I X["^"!(X="") G Q1
- I $E(Y,6,7)<1 D EN^DDIOL("Date missing! Enter date format: MM/DD/YY") G Q2
- I Y<PRCDATEF D EN^DDIOL("The beginning and ending dates are not in order") G Q2
- S PRCDATEE=Y
- G:'$G(PRCOPT) START
- Q3 ;select card holder
- S PRCDI="200;^VA(200,;"
- S X("S")="I Y-DUZ,$D(^PRC(440.5,""MAAH"",DUZ,+Y))"
- D LOOKUP^PRC0B(.X,.Y,PRCDI,"AEOQS","Select Purchase Card Holder: ")
- I Y<0!(X="") G Q1
- K X S PRCRI(200)=+Y,PRCDUZ=+Y
- ;
- START N L,DIC,FLDS,BY,FR,TO,DHD
- S DIC="^PRCH(440.6,",L=0,BY="#STATEMENT DATE;C1,@STATION NUMBER,@INTERNAL(CARD HOLDER),+""XXXXXXXXXXXX""_$E(CREDIT CARD NUMBER;C1;S1;""CHARGE DATA for CREDIT CARD #: "",13,16)"
- S FR=PRCDATEF_",1,"_PRCDUZ_",0",TO=PRCDATEE_",9999,"_PRCDUZ_",~"
- S PRCNAME=$P(^VA(200,PRCDUZ,0),"^"),PRCDATE=$$MDY(PRCDATEF)_" - "_$$MDY(PRCDATEE)
- S DHD="E-Charge Statement for "_PRCNAME_" Statement Date: "_PRCDATE
- S FLDS=".01;C1;S1;""Charge Id"",8;""PO Date"",31;L30;""Vendor"",20;C5;""P.O. #"",9;""TXN Ref"",&13;C60;R15;""Charge $AMT"",41;""IFCAP P.O. #"";C5;L16,6;""TXN DATE"",15;C50"
- D EN1^DIP G:$G(PRCOPT) Q3
- EXIT QUIT
- ;
- MDY(A) ;EV = MM/DD/YY
- QUIT $E(A,4,5)_"/"_$E(A,6,7)_"/"_$E(A,2,3)
- ;
- EN1 ;from approving official menu
- N PRCOPT
- S PRCOPT=1
- G EN
- ;
- EN2 ;from print unregistered card charges option
- S PRCOPT=2
- S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE")) Q:$G(X)="^"
- S DIC="^PRCH(440.6,",L=0
- S FLDS="3;""Credit Card #"";C1;N;L16,8;""PO Date"",31;L30;""Vendor"",20;C5;""P.O. #"",9;""TXN Ref"",&13;C60;R15;""Charge $AMT"",.01;C5;""Charge Id"",6;""TXN DATE"",15;C50"
- S DHD="Unregistered Credit Card Charges for Station #: "_PRC("SITE")
- S BY(0)="^PRCH(440.6,""ST"",""N~"","
- S L(0)=1
- S BY="3",FR="0",TO="99999999999999999999999"
- S DIS(0)="I $D(PRC(""SITE"")),$P(^PRCH(440.6,D0,0),""^"",8)=PRC(""SITE"")"
- D EN1^DIP
- QUIT
- ;
- EN3 ;charge card reg exception option
- N PRC
- S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE")) Q:$G(X)="^"
- S DIC="^PRC(440.5,",L=0
- S FLDS="60;""Charge Card #"";C1;S1;N,59;""Exp. Date"";L15,51;""Replaced Card #"",52;C5;""Card Holder"";L30,7;C36;""IFCAP CARD HOLDER"";L25,63;L10;C62;""FCP #"",53;C5;""Station"";L8,61;C22;""S.P. Limit"";L15,62;""M.P. Limit"";L15"
- S FLDS(1)="55;C5;""Fund Code"";L15,56;""ACC Code"";L15,57;""Cost Center"";L15,58;""BOC"";L15"
- S DHD="Charge Card Reg. Exception List"
- S BY(0)="^PRC(440.5,""ST"","
- S L(0)=2
- S BY="@70,@.01",FR="E",TO="E"
- S DIOEND="I Y'[""^"" D EOR^PRCH2A"
- S:$D(ZTIO) IOP=ZTIO
- S DIS(0)="I $D(PRC(""SITE"")),($P($G(^PRC(440.5,D0,2)),""^"",3)=PRC(""SITE"")!($P($G(^PRC(440.5,D0,50)),""^"",3)=PRC(""SITE"")))"
- D EN1^DIP
- QUIT
- EOR W !!,"* - Invalid data, it must be corrected by the charge card company.",!,"# - New charge card data may not match the old one.",!!,"END OF REPORT"
- I $E(IOST,1,2)="C-",'$D(ZTQUEUED) D EOP^PRC0A(.X,.Y,"Enter return to continue","","")
- QUIT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCH2A 3700 printed Feb 18, 2025@23:31:34 Page 2
- PRCH2A ;WISC/PLT-DAILY PURCHASE CARD CHARGES STATEMENT ; 6/28/99 3:18pm
- V ;;5.1;IFCAP;**8,125**;Oct 20, 2000;Build 15
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 ;invalid entry
- QUIT
- +3 ;
- EN ;print daily purchase card charges statement
- +1 NEW PRCA,PRCB,PRCDATE,PRCDATEF,PRCDATEE,PRCDUZ,PRCNAME
- +2 NEW A,B,C
- +3 SET PRCDUZ=DUZ
- Q1 ;statement from date
- +1 SET A=$$DATE^PRC0C($HOROLOG-2,"H")
- DO DT^PRC0A(.X,.Y,"For Credit Card Charge Statement Beginning Date: ","AO",$PIECE(A,"^",4)_"/"_$PIECE(A,"^",5)_"/"_$EXTRACT($PIECE(A,"^",3),3,4))
- +2 IF X["^"!(X="")
- GOTO EXIT
- +3 IF $EXTRACT(Y,6,7)<1
- DO EN^DDIOL("Date missing! Enter date format: MM/DD/YY")
- GOTO Q1
- +4 SET PRCDATEF=Y
- Q2 ;statement ending date
- +1 SET A=$$DATE^PRC0C(PRCDATEF,"I")
- DO DT^PRC0A(.X,.Y,"For Credit Card Charge Statement Ending Date: ","AO",$PIECE(A,"^",4)_"/"_$PIECE(A,"^",5)_"/"_$EXTRACT($PIECE(A,"^",3),3,4))
- +2 IF X["^"!(X="")
- GOTO Q1
- +3 IF $EXTRACT(Y,6,7)<1
- DO EN^DDIOL("Date missing! Enter date format: MM/DD/YY")
- GOTO Q2
- +4 IF Y<PRCDATEF
- DO EN^DDIOL("The beginning and ending dates are not in order")
- GOTO Q2
- +5 SET PRCDATEE=Y
- +6 if '$GET(PRCOPT)
- GOTO START
- Q3 ;select card holder
- +1 SET PRCDI="200;^VA(200,;"
- +2 SET X("S")="I Y-DUZ,$D(^PRC(440.5,""MAAH"",DUZ,+Y))"
- +3 DO LOOKUP^PRC0B(.X,.Y,PRCDI,"AEOQS","Select Purchase Card Holder: ")
- +4 IF Y<0!(X="")
- GOTO Q1
- +5 KILL X
- SET PRCRI(200)=+Y
- SET PRCDUZ=+Y
- +6 ;
- START NEW L,DIC,FLDS,BY,FR,TO,DHD
- +1 SET DIC="^PRCH(440.6,"
- SET L=0
- SET BY="#STATEMENT DATE;C1,@STATION NUMBER,@INTERNAL(CARD HOLDER),+""XXXXXXXXXXXX""_$E(CREDIT CARD NUMBER;C1;S1;""CHARGE DATA for CREDIT CARD #: "",13,16)"
- +2 SET FR=PRCDATEF_",1,"_PRCDUZ_",0"
- SET TO=PRCDATEE_",9999,"_PRCDUZ_",~"
- +3 SET PRCNAME=$PIECE(^VA(200,PRCDUZ,0),"^")
- SET PRCDATE=$$MDY(PRCDATEF)_" - "_$$MDY(PRCDATEE)
- +4 SET DHD="E-Charge Statement for "_PRCNAME_" Statement Date: "_PRCDATE
- +5 SET FLDS=".01;C1;S1;""Charge Id"",8;""PO Date"",31;L30;""Vendor"",20;C5;""P.O. #"",9;""TXN Ref"",&13;C60;R15;""Charge $AMT"",41;""IFCAP P.O. #"";C5;L16,6;""TXN DATE"",15;C50"
- +6 DO EN1^DIP
- if $GET(PRCOPT)
- GOTO Q3
- EXIT QUIT
- +1 ;
- MDY(A) ;EV = MM/DD/YY
- +1 QUIT $EXTRACT(A,4,5)_"/"_$EXTRACT(A,6,7)_"/"_$EXTRACT(A,2,3)
- +2 ;
- EN1 ;from approving official menu
- +1 NEW PRCOPT
- +2 SET PRCOPT=1
- +3 GOTO EN
- +4 ;
- EN2 ;from print unregistered card charges option
- +1 SET PRCOPT=2
- +2 SET PRCF("X")="S"
- DO ^PRCFSITE
- if '$DATA(PRC("SITE"))
- QUIT
- if $GET(X)="^"
- QUIT
- +3 SET DIC="^PRCH(440.6,"
- SET L=0
- +4 SET FLDS="3;""Credit Card #"";C1;N;L16,8;""PO Date"",31;L30;""Vendor"",20;C5;""P.O. #"",9;""TXN Ref"",&13;C60;R15;""Charge $AMT"",.01;C5;""Charge Id"",6;""TXN DATE"",15;C50"
- +5 SET DHD="Unregistered Credit Card Charges for Station #: "_PRC("SITE")
- +6 SET BY(0)="^PRCH(440.6,""ST"",""N~"","
- +7 SET L(0)=1
- +8 SET BY="3"
- SET FR="0"
- SET TO="99999999999999999999999"
- +9 SET DIS(0)="I $D(PRC(""SITE"")),$P(^PRCH(440.6,D0,0),""^"",8)=PRC(""SITE"")"
- +10 DO EN1^DIP
- +11 QUIT
- +12 ;
- EN3 ;charge card reg exception option
- +1 NEW PRC
- +2 SET PRCF("X")="S"
- DO ^PRCFSITE
- if '$DATA(PRC("SITE"))
- QUIT
- if $GET(X)="^"
- QUIT
- +3 SET DIC="^PRC(440.5,"
- SET L=0
- +4 SET FLDS="60;""Charge Card #"";C1;S1;N,59;""Exp. Date"";L15,51;""Replaced Card #"",52;C5;""Card Holder"";L30,7;C36;""IFCAP CARD HOLDER"";L25,63;L10;C62;""FCP #"",53;C5;""Station"";L8,61;C22;""S.P. Limit"";L15,62;""M.P. Limit"";L15"
- +5 SET FLDS(1)="55;C5;""Fund Code"";L15,56;""ACC Code"";L15,57;""Cost Center"";L15,58;""BOC"";L15"
- +6 SET DHD="Charge Card Reg. Exception List"
- +7 SET BY(0)="^PRC(440.5,""ST"","
- +8 SET L(0)=2
- +9 SET BY="@70,@.01"
- SET FR="E"
- SET TO="E"
- +10 SET DIOEND="I Y'[""^"" D EOR^PRCH2A"
- +11 if $DATA(ZTIO)
- SET IOP=ZTIO
- +12 SET DIS(0)="I $D(PRC(""SITE"")),($P($G(^PRC(440.5,D0,2)),""^"",3)=PRC(""SITE"")!($P($G(^PRC(440.5,D0,50)),""^"",3)=PRC(""SITE"")))"
- +13 DO EN1^DIP
- +14 QUIT
- EOR WRITE !!,"* - Invalid data, it must be corrected by the charge card company.",!,"# - New charge card data may not match the old one.",!!,"END OF REPORT"
- +1 IF $EXTRACT(IOST,1,2)="C-"
- IF '$DATA(ZTQUEUED)
- DO EOP^PRC0A(.X,.Y,"Enter return to continue","","")
- +2 QUIT