PRCH1E ;WISC/PLT-IFCAP RETRIEVE UNREGISTERED PURCHASE CARD CHARGES ;10/15/97 14:26
V ;;5.1;IFCAP;**8**;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
QUIT ;invalid entry
;
EN ;retrieve unregistered purchase card charges
N PRCA,PRCB,PRCRI
N A,B,C
S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE")) Q:$G(X)="^"
Q1 D YN^PRC0A(.X,.Y,"Ready to Retrieve Unregistered Purchase Card Charges","O","YES")
I X["^"!(X="")!'Y G EXIT
D EN^DDIOL("Start Retrieving:")
S PRCRI=0,PRCTR=0
F S PRCRI=$O(^PRCH(440.6,"ST","N~",PRCRI)) QUIT:'PRCRI D:$P(^PRCH(440.6,PRCRI,0),"^",17)="" K:$P(^PRCH(440.6,PRCRI,0),"^",17) ^PRCH(440.6,"ST","N~",PRCRI)
. N A,B,C,X,Y
. S A=^PRCH(440.6,PRCRI,0),B=$P(A,"^",4),PRCRI(440.5)=$O(^PRC(440.5,"B",B,0))
. QUIT:'PRCRI(440.5)
. S PRCRI(200)=$P(^PRC(440.5,PRCRI(440.5),0),"^",8) QUIT:PRCRI(200)=""
. I $D(PRC("SITE")) Q:$P(^PRC(440.5,PRCRI(440.5),2),"^",3)'=PRC("SITE")
. W "." D EDIT^PRC0B(.X,"440.6;^PRCH(440.6,;"_PRCRI,"16////"_PRCRI(200))
. S PRCTR=$G(PRCTR)+1
. QUIT
;
I $G(PRCTR)>0 W !!?5,"Found "_PRCTR_" charge(s). Task completed !!" H 2
I $G(PRCTR)=0 W !!?5,"No charges were found. Task completed !!" H 2
K PRCTR
EXIT QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCH1E 1227 printed Nov 22, 2024@17:15:15 Page 2
PRCH1E ;WISC/PLT-IFCAP RETRIEVE UNREGISTERED PURCHASE CARD CHARGES ;10/15/97 14:26
V ;;5.1;IFCAP;**8**;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;invalid entry
QUIT
+3 ;
EN ;retrieve unregistered purchase card charges
+1 NEW PRCA,PRCB,PRCRI
+2 NEW A,B,C
+3 SET PRCF("X")="S"
DO ^PRCFSITE
if '$DATA(PRC("SITE"))
QUIT
if $GET(X)="^"
QUIT
Q1 DO YN^PRC0A(.X,.Y,"Ready to Retrieve Unregistered Purchase Card Charges","O","YES")
+1 IF X["^"!(X="")!'Y
GOTO EXIT
+2 DO EN^DDIOL("Start Retrieving:")
+3 SET PRCRI=0
SET PRCTR=0
+4 FOR
SET PRCRI=$ORDER(^PRCH(440.6,"ST","N~",PRCRI))
if 'PRCRI
QUIT
if $PIECE(^PRCH(440.6,PRCRI,0),"^",17)=""
Begin DoDot:1
+5 NEW A,B,C,X,Y
+6 SET A=^PRCH(440.6,PRCRI,0)
SET B=$PIECE(A,"^",4)
SET PRCRI(440.5)=$ORDER(^PRC(440.5,"B",B,0))
+7 if 'PRCRI(440.5)
QUIT
+8 SET PRCRI(200)=$PIECE(^PRC(440.5,PRCRI(440.5),0),"^",8)
if PRCRI(200)=""
QUIT
+9 IF $DATA(PRC("SITE"))
if $PIECE(^PRC(440.5,PRCRI(440.5),2),"^",3)'=PRC("SITE")
QUIT
+10 WRITE "."
DO EDIT^PRC0B(.X,"440.6;^PRCH(440.6,;"_PRCRI,"16////"_PRCRI(200))
+11 SET PRCTR=$GET(PRCTR)+1
+12 QUIT
End DoDot:1
if $PIECE(^PRCH(440.6,PRCRI,0),"^",17)
KILL ^PRCH(440.6,"ST","N~",PRCRI)
+13 ;
+14 IF $GET(PRCTR)>0
WRITE !!?5,"Found "_PRCTR_" charge(s). Task completed !!"
HANG 2
+15 IF $GET(PRCTR)=0
WRITE !!?5,"No charges were found. Task completed !!"
HANG 2
+16 KILL PRCTR
EXIT QUIT
