PRCH1E.m

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 ---PRCH1E   1227     printed  Apr 09, 2024@21:08:21                                                                                                                                                                                                      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