PRCH1B1.m

PRCH1B1 ;WISC/PLT-PRCH1B continued ; 03/01/96  1:27 PM

V ;;5.1;IFCAP;;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 QUIT  ;invalid entry

 ;

APREC(PRCA) ;approve reconciled purchase card orders

 N PRC,PRCB,PRCC,PRCOPT,PRCRI,PRCDI,PRCDUZ,PRCST

 N A,B,C,X,Y

 S PRCRI(442)=PRCA G APP

 D PIECE^PRC0B("442;^PRC(442,;"_PRCRI(442),".01;.5;91;92;13;56","E","A")

 W !,"PURCHASE CARD ORDER: ",$G(A(442,PRCRI(442),.01,"E")),?40,"STATUS: ",$G(A(442,PRCRI(442),.5,"E"))

 W !,"TOTAL AMOUNT: ",$J($G(A(442,PRCRI(442),91,"E")),8,2),?40,"NET AMOUNT: ",$J($G(A(442,PRCRI(442),92,"E")),8,2)

 W !,"EST. SHIP/HANDLING: ",$J($G(A(442,PRCRI(442),13,"E")),8,2)

 W !,"PURCHASE CARD ORDER BY: ",$G(A(442,PRCRI(442),56,"E"))

 S PRC("SITE")=$P($G(A(442,PRCRI(442),.01,"E")),"-")

 K A

Q1 D YN^PRC0A(.X,.Y,"Display Purchase Card Order","O","NO")

 I X["^"!(X="") G EXIT

 I Y D

 . N D0 S D0=PRCRI(442) D ^PRCHDP1

 . QUIT

Q2 D YN^PRC0A(.X,.Y,"Ready to Approve","O","YES")

 I X["^"!(X="")!'Y G EXIT

APP S PRCST=$S($D(^PRC(442,PRCRI(442),6)):41,1:40)

 D EDIT^PRC0B(.X,"442;^PRC(442,;"_PRCRI(442),".5///"_PRCST_";57////"_DUZ)

 N APPDATE,TEMP,P4406 S TEMP=X D NOW^%DTC S APPDATE=X,X=TEMP

 S P4406="" F  S P4406=$O(^PRCH(440.6,"PO",PRCRI(442),P4406)) Q:P4406=""  D EDIT^PRC0B(.X,"440.6;^PRCH(440.6,;"_P4406,"26///"_APPDATE_";27////"_DUZ)

EXIT D EN^DDIOL(" ") QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCH1B1   1389     printed  Apr 09, 2024@21:05:24                                                                                                                                                                                                     Page 2

PRCH1B1   ;WISC/PLT-PRCH1B continued ; 03/01/96  1:27 PM

V         ;;5.1;IFCAP;;Oct 20, 2000

 +1       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +2       ;invalid entry

           QUIT 

 +3       ;

APREC(PRCA) ;approve reconciled purchase card orders

 +1        NEW PRC,PRCB,PRCC,PRCOPT,PRCRI,PRCDI,PRCDUZ,PRCST

 +2        NEW A,B,C,X,Y

 +3        SET PRCRI(442)=PRCA

           GOTO APP

 +4        DO PIECE^PRC0B("442;^PRC(442,;"_PRCRI(442),".01;.5;91;92;13;56","E","A")

 +5        WRITE !,"PURCHASE CARD ORDER: ",$GET(A(442,PRCRI(442),.01,"E")),?40,"STATUS: ",$GET(A(442,PRCRI(442),.5,"E"))

 +6        WRITE !,"TOTAL AMOUNT: ",$JUSTIFY($GET(A(442,PRCRI(442),91,"E")),8,2),?40,"NET AMOUNT: ",$JUSTIFY($GET(A(442,PRCRI(442),92,"E")),8,2)

 +7        WRITE !,"EST. SHIP/HANDLING: ",$JUSTIFY($GET(A(442,PRCRI(442),13,"E")),8,2)

 +8        WRITE !,"PURCHASE CARD ORDER BY: ",$GET(A(442,PRCRI(442),56,"E"))

 +9        SET PRC("SITE")=$PIECE($GET(A(442,PRCRI(442),.01,"E")),"-")

 +10       KILL A

Q1         DO YN^PRC0A(.X,.Y,"Display Purchase Card Order","O","NO")

 +1        IF X["^"!(X="")

               GOTO EXIT

 +2        IF Y

               Begin DoDot:1

 +3                NEW D0

                   SET D0=PRCRI(442)

                   DO ^PRCHDP1

 +4                QUIT 

               End DoDot:1

Q2         DO YN^PRC0A(.X,.Y,"Ready to Approve","O","YES")

 +1        IF X["^"!(X="")!'Y

               GOTO EXIT

APP        SET PRCST=$SELECT($DATA(^PRC(442,PRCRI(442),6)):41,1:40)

 +1        DO EDIT^PRC0B(.X,"442;^PRC(442,;"_PRCRI(442),".5///"_PRCST_";57////"_DUZ)

 +2        NEW APPDATE,TEMP,P4406

           SET TEMP=X

           DO NOW^%DTC

           SET APPDATE=X

           SET X=TEMP

 +3        SET P4406=""

           FOR 

               SET P4406=$ORDER(^PRCH(440.6,"PO",PRCRI(442),P4406))

               if P4406=""

                   QUIT 

               DO EDIT^PRC0B(.X,"440.6;^PRCH(440.6,;"_P4406,"26///"_APPDATE_";27////"_DUZ)

EXIT       DO EN^DDIOL(" ")

           QUIT