- PRCHRP5 ;WISC/KMB/CR-RECONCILED PURCHASE CARD ORDERS ;6/29/98 15:27
- ;;5.1;IFCAP;**8**;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- START ;
- ; set check for reconciled reports
- N FLAG S FLAG=1 G EN
- START1 ;
- ; entry point for unreconciled reports
- N FLAG S FLAG=0
- EN K ^TMP($J)
- N CCTOT,XXZ,LIN,CCREF,CCRF,CCAMT,CP,PCARD,PO,P,PA,PRC,PRCRI,LABEL,XX,F1,F2,F3,F4,STATUS,YY,Y,PDATE,VEND,RDATE,RPTDATE,PC,USER,AMT,XXZ,EX,COUNT,FDATE,EDATE,TYPE
- N RMPR,RMPR1,OSTAT,OREC,OREC6,MERC,CNTCC,CNTSTR,P,LN,Z0,Z1,Z2,Z3,Z4
- S:$G(FLAG)="" FLAG=0 S:$G(FLG)="" FLG=""
- S:$G(FLAG)=1 LABEL="START" S:$G(FLAG)=0 LABEL="START1"
- S PRCF("X")="S" D ^PRCFSITE I '$D(PRC("SITE")) K FLAG QUIT
- Q:$G(X)="^"
- ;
- RANGE ;
- S DIR("A")="Enter beginning date",DIR("?")="Enter the first date for which you wish to see records"
- S DIR(0)="D^^" D ^DIR K DIR Q:+Y<1 S FDATE=+Y W " ",Y(0)
- S DIR("A")="Enter ending date",DIR("?")="Enter the last date for which you wish to see records"
- S DIR(0)="D^^" D ^DIR K DIR Q:+Y<1 S EDATE=+Y W " ",Y(0)
- I EDATE<FDATE W !,"Date range is incorrect." G RANGE
- I $G(X)="^" K FLG,FLAG Q
- S %ZIS("B")="",%ZIS="MQ" D ^%ZIS Q:POP
- I $D(IO("Q")) S ZTRTN="DETAIL^PRCHRP5",ZTSAVE("*")="" D ^%ZTLOAD,^%ZISC K FLG,FLAG,^TMP($J) Q
- D DETAIL,^%ZISC K FLG,FLAG,^TMP($J)
- Q
- DETAIL ;
- ;variable F4 is used to store the first line from the COMMENTS
- ;field. If there is a Prosthetics entry for the order, the
- ;first line of file 664's REMARKS field is stored in F4.
- S COUNT=1,XX="" F S XX=$O(^PRC(442,"F",25,XX)) Q:XX="" D
- .S (CCREF,CCRF,CCAMT)=""
- .S F1=$G(^PRC(442,XX,0)) S CP=$P(F1,"^",3)
- .S F2=$G(^PRC(442,XX,1)),F3=$G(^PRC(442,XX,2,1,1,1,0))
- .S F4=$G(^PRC(442,XX,4,1,0))
- .S STATUS=+$P($G(^PRC(442,XX,7)),"^",2)
- .Q:(STATUS=1)!(STATUS=45)
- .I $G(FLAG)=1 Q:"^40^41^50^51^"'[("^"_STATUS_"^")
- .I $G(FLAG)=0 Q:"^4^5^6^40^41^50^51^"[("^"_STATUS_"^")
- .I $D(PRC("SITE")) Q:$P(F1,"-",1)'=PRC("SITE")
- .I $G(FLAG)=1 S Y=$P($G(^PRC(442,XX,23)),"^",19) Q:Y<FDATE Q:Y>EDATE
- .I $G(FLAG)'=1 S Y=$P(F2,"^",15) Q:Y<FDATE Q:Y>EDATE
- .I $P($G(^PRC(442,XX,24)),"^",3)="RMPR" S RMPR=$P(F1,"^") I $D(^RMPR(664,"AC",RMPR)) S RMPR1=$O(^RMPR(664,"AC",RMPR,0)),F4=$P($G(^RMPR(664,+RMPR1,1,1,0)),"^",8)
- .S PC=$P($G(^PRC(442,XX,23)),"^",8),PC=$P($G(^PRC(440.5,+PC,0)),"^") S:PC="" PC=0
- .S STATUS=$P($G(^PRC(442,XX,7)),"^")
- .I $G(FLAG)=1 Q:$P($G(^PRC(442,XX,23)),"^",19)=""
- .S PCARD=$P($G(^PRC(442,XX,23)),"^",8) Q:PCARD=""
- .I $G(FLG)=2 I $P($G(^PRC(440.5,PCARD,0)),"^",10)'=DUZ,$P($G(^PRC(440.5,PCARD,0)),"^",9)'=DUZ Q
- .I $G(FLG)=1 Q:$P($G(^PRC(440.5,PCARD,0)),"^",8)'=DUZ
- .S STATUS=$P($G(^PRCD(442.3,STATUS,0)),"^")
- .S USER=$P($G(^PRC(440.5,PCARD,0)),"^",8) Q:USER=""
- .S USER=$P($G(^VA(200,+USER,0)),"^"),VEND=$P(F2,"^"),VEND=$P($G(^PRC(440,+VEND,0)),"^"),AMT=$P(F1,"^",15)
- .I VEND="SIMPLIFIED",$P($G(^PRC(442,XX,24)),"^",2)'="" S VEND=$P($G(^PRC(442,XX,24)),"^",2)
- .S VEND=$E(VEND,1,30)
- .Q:USER=""
- .S PO=$P(F1,"^")
- .S (YY,Y)=$P(F2,"^",15) D DD^%DT S PDATE=Y
- .S Y=$P($G(^PRC(442,XX,23)),"^",19),TYPE=$P($G(^PRC(442,XX,23)),"^",11) D DD^%DT S RDATE=Y
- .S:TYPE["D" TYPE="DELIV." S:TYPE="P" TYPE="DETAILED" S:TYPE="S" TYPE="SIMPLIFIED"
- .S CCTOT=0 I $G(FLAG)=1,$O(^PRCH(440.6,"PO",XX,0))'="" S CCREF=0 D
- ..F S CCREF=$O(^PRCH(440.6,"PO",XX,CCREF)) Q:CCREF="" D
- ...S OREC=$G(^PRCH(440.6,CCREF,0)),OREC6=$G(^PRCH(440.6,CCREF,6))
- ...S OSTAT="NO" I $P($G(^PRCH(440.6,CCREF,1)),"^",4)="Y" S OSTAT="YES"
- ...S CCRF=$P(OREC,"^"),CCAMT=$P(OREC,"^",14),MERC=$P(OREC6,"^") S ^TMP($J,USER,PC,YY,COUNT,3,CCREF)=CCRF_"^"_CCAMT_"^"_MERC_"^"_OSTAT
- ...S CCTOT=CCTOT+CCAMT
- .S ^TMP($J,USER,PC,YY,COUNT,4)=$J(CCTOT,0,2)
- .S:$G(FLAG)=0&($P($G(^PRC(442,XX,23)),"^",19)'="") RDATE=""
- .S ^TMP($J,USER,PC,YY,COUNT)=PDATE_"^"_RDATE_"^"_PO_"^"_AMT_"^"_VEND_"^"_STATUS_"^"_TYPE_"^"_USER
- .S ^TMP($J,USER,PC,YY,COUNT,1)=$E(F3,1,35) S ^TMP($J,USER,PC,YY,COUNT,2)=$E(F4,1,55)
- .S:$G(^TMP($J,USER,2))="" ^TMP($J,USER,2)=0 S ^TMP($J,USER,2)=^TMP($J,USER,2)+AMT
- .S COUNT=COUNT+1
- ;
- WRITE ;
- S X=DT D NOW^%DTC,YX^%DTC S RPTDATE=Y
- U IO S U="^",P=1,EX=""
- I '$D(^TMP($J)) S Z0="" S FLAG=$S($G(FLAG)=1:1,$G(FLAG)=0:0,1:1) D HEADER W !!!!,?10,"*** NO RECORDS TO PRINT ***" Q
- ;
- S Z0=0 F S Z0=$O(^TMP($J,Z0)) Q:Z0="" Q:EX[U D
- .D HEADER
- .S Z1="" F S Z1=$O(^TMP($J,Z0,Z1)) Q:Z1="" Q:EX[U D
- ..S Z2="" F S Z2=$O(^TMP($J,Z0,Z1,Z2)) Q:Z2="" Q:EX[U D
- ...S Z3="" F S Z3=$O(^TMP($J,Z0,Z1,Z2,Z3)) Q:Z3="" Q:EX[U D
- ....W ! S LN=^TMP($J,Z0,Z1,Z2,Z3) W !,$P(LN,"^"),?20,$P(LN,"^",2),?40,$P(LN,"^",3),?55,$J($P(LN,"^",4),0,2),?67,$P(LN,"^",7)
- ....S LIN=^TMP($J,Z0,Z1,Z2,Z3,1) W !,$P(LN,"^",5),?40,$P(LIN,"^")
- ....W !,$P(LN,"^",6)
- ....I $G(FLAG)=1,$G(FLG)=1 W !,^TMP($J,Z0,Z1,Z2,Z3,2)
- ....I $G(FLAG)=1 S CNTCC="" F S CNTCC=$O(^TMP($J,Z0,Z1,Z2,Z3,3,CNTCC)) Q:CNTCC="" S CNTSTR=^TMP($J,Z0,Z1,Z2,Z3,3,CNTCC) W !,$P(CNTSTR,"^"),?20,$P(CNTSTR,"^",2),?40,$P(CNTSTR,"^",3),?67,$P(CNTSTR,"^",4)
- ....I (IOSL-$Y)<6 D HOLD Q:EX[U
- ....I $G(FLAG)=1 W !," RECONCILED SUBTOTAL - $",^TMP($J,Z0,Z1,Z2,Z3,4)
- ....I $G(FLAG)=0 W !,^TMP($J,Z0,Z1,Z2,Z3,2)
- .W !," BUYER SUBTOTAL - $",$J(^TMP($J,Z0,2),0,2)
- .I $E(IOST,1,2)="C-",EX'[U W !,"Press return to continue, '^' to exit: " R XXZ:DTIME S:XXZ[U EX=U S:'$T EX=U
- K Z0,Z1,Z2,Z3
- Q
- ;
- HOLD G HEADER:$E(IOST,1,2)'="C-"!(IO'=IO(0)) W !,"Press return to continue, '^' to exit: " R XXZ:DTIME S:XXZ[U EX=U S:'$T EX=U I EX'=U,$G(Z1)'="",$G(Z3)'="" D HEADER
- QUIT
- ;
- W @IOF W !
- I $G(FLAG)=0 W "UNRECONCILED"
- I $G(FLAG)=1 W "RECONCILED"
- W " PURCHASE CARD ORDERS",?45,RPTDATE,?70,"PAGE ",P
- W !,"P.O. DATE"
- I $G(FLAG)=1 W ?20,"DATE RECONCILED"
- W ?40,"ORDER #",?55,"$AMT",?67,"TYPE(S/D)",!,"VENDOR",?40,"DESCRIPTION"
- W !,"STATUS" I $G(FLAG)=0 W !,"COMMENTS"
- I $G(FLAG)=1,$G(FLG)=1 W !,"COMMENTS"
- I $G(FLAG)=1 W !,"DOC-REF #",?20,"RECONCILED $AMT",?40,"RECONCILE VENDOR",?67,"FINAL CHARGE"
- W ! F I=1:1:8 W "----------"
- W !,"BUYER: ",Z0
- S P=P+1
- QUIT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHRP5 6037 printed Mar 13, 2025@21:15:08 Page 2
- PRCHRP5 ;WISC/KMB/CR-RECONCILED PURCHASE CARD ORDERS ;6/29/98 15:27
- +1 ;;5.1;IFCAP;**8**;Oct 20, 2000
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- START ;
- +1 ; set check for reconciled reports
- +2 NEW FLAG
- SET FLAG=1
- GOTO EN
- START1 ;
- +1 ; entry point for unreconciled reports
- +2 NEW FLAG
- SET FLAG=0
- EN KILL ^TMP($JOB)
- +1 NEW CCTOT,XXZ,LIN,CCREF,CCRF,CCAMT,CP,PCARD,PO,P,PA,PRC,PRCRI,LABEL,XX,F1,F2,F3,F4,STATUS,YY,Y,PDATE,VEND,RDATE,RPTDATE,PC,USER,AMT,XXZ,EX,COUNT,FDATE,EDATE,TYPE
- +2 NEW RMPR,RMPR1,OSTAT,OREC,OREC6,MERC,CNTCC,CNTSTR,P,LN,Z0,Z1,Z2,Z3,Z4
- +3 if $GET(FLAG)=""
- SET FLAG=0
- if $GET(FLG)=""
- SET FLG=""
- +4 if $GET(FLAG)=1
- SET LABEL="START"
- if $GET(FLAG)=0
- SET LABEL="START1"
- +5 SET PRCF("X")="S"
- DO ^PRCFSITE
- IF '$DATA(PRC("SITE"))
- KILL FLAG
- QUIT
- +6 if $GET(X)="^"
- QUIT
- +7 ;
- RANGE ;
- +1 SET DIR("A")="Enter beginning date"
- SET DIR("?")="Enter the first date for which you wish to see records"
- +2 SET DIR(0)="D^^"
- DO ^DIR
- KILL DIR
- if +Y<1
- QUIT
- SET FDATE=+Y
- WRITE " ",Y(0)
- +3 SET DIR("A")="Enter ending date"
- SET DIR("?")="Enter the last date for which you wish to see records"
- +4 SET DIR(0)="D^^"
- DO ^DIR
- KILL DIR
- if +Y<1
- QUIT
- SET EDATE=+Y
- WRITE " ",Y(0)
- +5 IF EDATE<FDATE
- WRITE !,"Date range is incorrect."
- GOTO RANGE
- +6 IF $GET(X)="^"
- KILL FLG,FLAG
- QUIT
- +7 SET %ZIS("B")=""
- SET %ZIS="MQ"
- DO ^%ZIS
- if POP
- QUIT
- +8 IF $DATA(IO("Q"))
- SET ZTRTN="DETAIL^PRCHRP5"
- SET ZTSAVE("*")=""
- DO ^%ZTLOAD
- DO ^%ZISC
- KILL FLG,FLAG,^TMP($JOB)
- QUIT
- +9 DO DETAIL
- DO ^%ZISC
- KILL FLG,FLAG,^TMP($JOB)
- +10 QUIT
- DETAIL ;
- +1 ;variable F4 is used to store the first line from the COMMENTS
- +2 ;field. If there is a Prosthetics entry for the order, the
- +3 ;first line of file 664's REMARKS field is stored in F4.
- +4 SET COUNT=1
- SET XX=""
- FOR
- SET XX=$ORDER(^PRC(442,"F",25,XX))
- if XX=""
- QUIT
- Begin DoDot:1
- +5 SET (CCREF,CCRF,CCAMT)=""
- +6 SET F1=$GET(^PRC(442,XX,0))
- SET CP=$PIECE(F1,"^",3)
- +7 SET F2=$GET(^PRC(442,XX,1))
- SET F3=$GET(^PRC(442,XX,2,1,1,1,0))
- +8 SET F4=$GET(^PRC(442,XX,4,1,0))
- +9 SET STATUS=+$PIECE($GET(^PRC(442,XX,7)),"^",2)
- +10 if (STATUS=1)!(STATUS=45)
- QUIT
- +11 IF $GET(FLAG)=1
- if "^40^41^50^51^"'[("^"_STATUS_"^")
- QUIT
- +12 IF $GET(FLAG)=0
- if "^4^5^6^40^41^50^51^"[("^"_STATUS_"^")
- QUIT
- +13 IF $DATA(PRC("SITE"))
- if $PIECE(F1,"-",1)'=PRC("SITE")
- QUIT
- +14 IF $GET(FLAG)=1
- SET Y=$PIECE($GET(^PRC(442,XX,23)),"^",19)
- if Y<FDATE
- QUIT
- if Y>EDATE
- QUIT
- +15 IF $GET(FLAG)'=1
- SET Y=$PIECE(F2,"^",15)
- if Y<FDATE
- QUIT
- if Y>EDATE
- QUIT
- +16 IF $PIECE($GET(^PRC(442,XX,24)),"^",3)="RMPR"
- SET RMPR=$PIECE(F1,"^")
- IF $DATA(^RMPR(664,"AC",RMPR))
- SET RMPR1=$ORDER(^RMPR(664,"AC",RMPR,0))
- SET F4=$PIECE($GET(^RMPR(664,+RMPR1,1,1,0)),"^",8)
- +17 SET PC=$PIECE($GET(^PRC(442,XX,23)),"^",8)
- SET PC=$PIECE($GET(^PRC(440.5,+PC,0)),"^")
- if PC=""
- SET PC=0
- +18 SET STATUS=$PIECE($GET(^PRC(442,XX,7)),"^")
- +19 IF $GET(FLAG)=1
- if $PIECE($GET(^PRC(442,XX,23)),"^",19)=""
- QUIT
- +20 SET PCARD=$PIECE($GET(^PRC(442,XX,23)),"^",8)
- if PCARD=""
- QUIT
- +21 IF $GET(FLG)=2
- IF $PIECE($GET(^PRC(440.5,PCARD,0)),"^",10)'=DUZ
- IF $PIECE($GET(^PRC(440.5,PCARD,0)),"^",9)'=DUZ
- QUIT
- +22 IF $GET(FLG)=1
- if $PIECE($GET(^PRC(440.5,PCARD,0)),"^",8)'=DUZ
- QUIT
- +23 SET STATUS=$PIECE($GET(^PRCD(442.3,STATUS,0)),"^")
- +24 SET USER=$PIECE($GET(^PRC(440.5,PCARD,0)),"^",8)
- if USER=""
- QUIT
- +25 SET USER=$PIECE($GET(^VA(200,+USER,0)),"^")
- SET VEND=$PIECE(F2,"^")
- SET VEND=$PIECE($GET(^PRC(440,+VEND,0)),"^")
- SET AMT=$PIECE(F1,"^",15)
- +26 IF VEND="SIMPLIFIED"
- IF $PIECE($GET(^PRC(442,XX,24)),"^",2)'=""
- SET VEND=$PIECE($GET(^PRC(442,XX,24)),"^",2)
- +27 SET VEND=$EXTRACT(VEND,1,30)
- +28 if USER=""
- QUIT
- +29 SET PO=$PIECE(F1,"^")
- +30 SET (YY,Y)=$PIECE(F2,"^",15)
- DO DD^%DT
- SET PDATE=Y
- +31 SET Y=$PIECE($GET(^PRC(442,XX,23)),"^",19)
- SET TYPE=$PIECE($GET(^PRC(442,XX,23)),"^",11)
- DO DD^%DT
- SET RDATE=Y
- +32 if TYPE["D"
- SET TYPE="DELIV."
- if TYPE="P"
- SET TYPE="DETAILED"
- if TYPE="S"
- SET TYPE="SIMPLIFIED"
- +33 SET CCTOT=0
- IF $GET(FLAG)=1
- IF $ORDER(^PRCH(440.6,"PO",XX,0))'=""
- SET CCREF=0
- Begin DoDot:2
- +34 FOR
- SET CCREF=$ORDER(^PRCH(440.6,"PO",XX,CCREF))
- if CCREF=""
- QUIT
- Begin DoDot:3
- +35 SET OREC=$GET(^PRCH(440.6,CCREF,0))
- SET OREC6=$GET(^PRCH(440.6,CCREF,6))
- +36 SET OSTAT="NO"
- IF $PIECE($GET(^PRCH(440.6,CCREF,1)),"^",4)="Y"
- SET OSTAT="YES"
- +37 SET CCRF=$PIECE(OREC,"^")
- SET CCAMT=$PIECE(OREC,"^",14)
- SET MERC=$PIECE(OREC6,"^")
- SET ^TMP($JOB,USER,PC,YY,COUNT,3,CCREF)=CCRF_"^"_CCAMT_"^"_MERC_"^"_OSTAT
- +38 SET CCTOT=CCTOT+CCAMT
- End DoDot:3
- End DoDot:2
- +39 SET ^TMP($JOB,USER,PC,YY,COUNT,4)=$JUSTIFY(CCTOT,0,2)
- +40 if $GET(FLAG)=0&($PIECE($GET(^PRC(442,XX,23)),"^",19)'="")
- SET RDATE=""
- +41 SET ^TMP($JOB,USER,PC,YY,COUNT)=PDATE_"^"_RDATE_"^"_PO_"^"_AMT_"^"_VEND_"^"_STATUS_"^"_TYPE_"^"_USER
- +42 SET ^TMP($JOB,USER,PC,YY,COUNT,1)=$EXTRACT(F3,1,35)
- SET ^TMP($JOB,USER,PC,YY,COUNT,2)=$EXTRACT(F4,1,55)
- +43 if $GET(^TMP($JOB,USER,2))=""
- SET ^TMP($JOB,USER,2)=0
- SET ^TMP($JOB,USER,2)=^TMP($JOB,USER,2)+AMT
- +44 SET COUNT=COUNT+1
- End DoDot:1
- +45 ;
- WRITE ;
- +1 SET X=DT
- DO NOW^%DTC
- DO YX^%DTC
- SET RPTDATE=Y
- +2 USE IO
- SET U="^"
- SET P=1
- SET EX=""
- +3 IF '$DATA(^TMP($JOB))
- SET Z0=""
- SET FLAG=$SELECT($GET(FLAG)=1:1,$GET(FLAG)=0:0,1:1)
- DO HEADER
- WRITE !!!!,?10,"*** NO RECORDS TO PRINT ***"
- QUIT
- +4 ;
- +5 SET Z0=0
- FOR
- SET Z0=$ORDER(^TMP($JOB,Z0))
- if Z0=""
- QUIT
- if EX[U
- QUIT
- Begin DoDot:1
- +6 DO HEADER
- +7 SET Z1=""
- FOR
- SET Z1=$ORDER(^TMP($JOB,Z0,Z1))
- if Z1=""
- QUIT
- if EX[U
- QUIT
- Begin DoDot:2
- +8 SET Z2=""
- FOR
- SET Z2=$ORDER(^TMP($JOB,Z0,Z1,Z2))
- if Z2=""
- QUIT
- if EX[U
- QUIT
- Begin DoDot:3
- +9 SET Z3=""
- FOR
- SET Z3=$ORDER(^TMP($JOB,Z0,Z1,Z2,Z3))
- if Z3=""
- QUIT
- if EX[U
- QUIT
- Begin DoDot:4
- +10 WRITE !
- SET LN=^TMP($JOB,Z0,Z1,Z2,Z3)
- WRITE !,$PIECE(LN,"^"),?20,$PIECE(LN,"^",2),?40,$PIECE(LN,"^",3),?55,$JUSTIFY($PIECE(LN,"^",4),0,2),?67,$PIECE(LN,"^",7)
- +11 SET LIN=^TMP($JOB,Z0,Z1,Z2,Z3,1)
- WRITE !,$PIECE(LN,"^",5),?40,$PIECE(LIN,"^")
- +12 WRITE !,$PIECE(LN,"^",6)
- +13 IF $GET(FLAG)=1
- IF $GET(FLG)=1
- WRITE !,^TMP($JOB,Z0,Z1,Z2,Z3,2)
- +14 IF $GET(FLAG)=1
- SET CNTCC=""
- FOR
- SET CNTCC=$ORDER(^TMP($JOB,Z0,Z1,Z2,Z3,3,CNTCC))
- if CNTCC=""
- QUIT
- SET CNTSTR=^TMP($JOB,Z0,Z1,Z2,Z3,3,CNTCC)
- WRITE !,$PIECE(CNTSTR,"^"),?20,$PIECE(CNTSTR,"^",2),?40,$PIECE(CNTSTR,"^",3),?67,$PIECE(CNTSTR,"^",4)
- +15 IF (IOSL-$Y)<6
- DO HOLD
- if EX[U
- QUIT
- +16 IF $GET(FLAG)=1
- WRITE !," RECONCILED SUBTOTAL - $",^TMP($JOB,Z0,Z1,Z2,Z3,4)
- +17 IF $GET(FLAG)=0
- WRITE !,^TMP($JOB,Z0,Z1,Z2,Z3,2)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +18 WRITE !," BUYER SUBTOTAL - $",$JUSTIFY(^TMP($JOB,Z0,2),0,2)
- +19 IF $EXTRACT(IOST,1,2)="C-"
- IF EX'[U
- WRITE !,"Press return to continue, '^' to exit: "
- READ XXZ:DTIME
- if XXZ[U
- SET EX=U
- if '$TEST
- SET EX=U
- End DoDot:1
- +20 KILL Z0,Z1,Z2,Z3
- +21 QUIT
- +22 ;
- HOLD if $EXTRACT(IOST,1,2)'="C-"!(IO'=IO(0))
- GOTO HEADER
- WRITE !,"Press return to continue, '^' to exit: "
- READ XXZ:DTIME
- if XXZ[U
- SET EX=U
- if '$TEST
- SET EX=U
- IF EX'=U
- IF $GET(Z1)'=""
- IF $GET(Z3)'=""
- DO HEADER
- +1 QUIT
- +2 ;
- +1 WRITE @IOF
- WRITE !
- +2 IF $GET(FLAG)=0
- WRITE "UNRECONCILED"
- +3 IF $GET(FLAG)=1
- WRITE "RECONCILED"
- +4 WRITE " PURCHASE CARD ORDERS",?45,RPTDATE,?70,"PAGE ",P
- +5 WRITE !,"P.O. DATE"
- +6 IF $GET(FLAG)=1
- WRITE ?20,"DATE RECONCILED"
- +7 WRITE ?40,"ORDER #",?55,"$AMT",?67,"TYPE(S/D)",!,"VENDOR",?40,"DESCRIPTION"
- +8 WRITE !,"STATUS"
- IF $GET(FLAG)=0
- WRITE !,"COMMENTS"
- +9 IF $GET(FLAG)=1
- IF $GET(FLG)=1
- WRITE !,"COMMENTS"
- +10 IF $GET(FLAG)=1
- WRITE !,"DOC-REF #",?20,"RECONCILED $AMT",?40,"RECONCILE VENDOR",?67,"FINAL CHARGE"
- +11 WRITE !
- FOR I=1:1:8
- WRITE "----------"
- +12 WRITE !,"BUYER: ",Z0
- +13 SET P=P+1
- +14 QUIT
