PRCHCARD ;WISC/AKS-Purchase Card Reconciliation Report ;
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
N PRCHFR,PRCHTO,FR,TO,L,DIC,BY,FLDS,Y,FROM,LASTTO,DIS,PRCF
S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE"))
S DIR(0)="F",DIR("?")="This is the valid Fund Control Point."
S DIR("A")="START WITH FCP",DIR("B")="FIRST" D ^DIR Q:X["^"
S (FROM,PRCHFR)=Y I Y?1.N S PRCHFR=Y_" "
I Y="FIRST" S PRCHFR="" K DIR,X
S (PRCHTO,LASTTO)="" I $G(Y)'="FIRST" D LAST Q:X["^"
PRINT I FROM]LASTTO S PRCHTO=LASTTO
S FR=PRCHFR_",?,?",TO=PRCHTO_",?,?"
S L=0,DIC=442,BY="[PRCH CREDIT SORT]"
S DIS(0)="I $P(^PRC(442,D0,0),U,2)=25"
S FLDS="[PRCH CARD PRINT" D EN1^DIP
I PRCHFR]"",PRCHTO]"",FROM]LASTTO D LAST Q:X["^" G PRINT
QUIT
LAST S DIR(0)="F",DIR("?")="This is the valid Fund Control Point."
S DIR("A")="GO TO FCP",DIR("B")="LAST" D ^DIR Q:X["^"
S (LASTTO,PRCHTO)=Y
I Y?1.N S PRCHTO=Y_"z"
I Y="LAST" S PRCHTO="" K DIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHCARD 990 printed Dec 13, 2024@02:06:02 Page 2
PRCHCARD ;WISC/AKS-Purchase Card Reconciliation Report ;
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 NEW PRCHFR,PRCHTO,FR,TO,L,DIC,BY,FLDS,Y,FROM,LASTTO,DIS,PRCF
+4 SET PRCF("X")="S"
DO ^PRCFSITE
if '$DATA(PRC("SITE"))
QUIT
+5 SET DIR(0)="F"
SET DIR("?")="This is the valid Fund Control Point."
+6 SET DIR("A")="START WITH FCP"
SET DIR("B")="FIRST"
DO ^DIR
if X["^"
QUIT
+7 SET (FROM,PRCHFR)=Y
IF Y?1.N
SET PRCHFR=Y_" "
+8 IF Y="FIRST"
SET PRCHFR=""
KILL DIR,X
+9 SET (PRCHTO,LASTTO)=""
IF $GET(Y)'="FIRST"
DO LAST
if X["^"
QUIT
PRINT IF FROM]LASTTO
SET PRCHTO=LASTTO
+1 SET FR=PRCHFR_",?,?"
SET TO=PRCHTO_",?,?"
+2 SET L=0
SET DIC=442
SET BY="[PRCH CREDIT SORT]"
+3 SET DIS(0)="I $P(^PRC(442,D0,0),U,2)=25"
+4 SET FLDS="[PRCH CARD PRINT"
DO EN1^DIP
+5 IF PRCHFR]""
IF PRCHTO]""
IF FROM]LASTTO
DO LAST
if X["^"
QUIT
GOTO PRINT
+6 QUIT
LAST SET DIR(0)="F"
SET DIR("?")="This is the valid Fund Control Point."
+1 SET DIR("A")="GO TO FCP"
SET DIR("B")="LAST"
DO ^DIR
if X["^"
QUIT
+2 SET (LASTTO,PRCHTO)=Y
+3 IF Y?1.N
SET PRCHTO=Y_"z"
+4 IF Y="LAST"
SET PRCHTO=""
KILL DIR
+5 QUIT
