PRCHRPT6.m

PRCHRPT6 ;BOISE/TKW-SUPPLEMENT TO PRCHRPT5--BUILD PRINT LOG OF REQUESTS/P.O.'S AND REPRINT ;4/27/89  9:59 AM ;2/19/92  3:50 PM

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

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

 ;

EN1 ; REPRINT REQUESTS PRINTED IN A&MM (2237'S)

 D ST Q:'$D(PRC("SITE"))  S M1="Requests",M2="A&MM (2237's)",M5="R1"

 G SELLST

 ;

EN2 ; REPRINT REQUESTS PRINTED IN FISCAL (1358'S)

 D ST Q:'$D(PRC("SITE"))  S M1="Requests",M2="Fiscal (1358's)",M5="R2"

 G SELLST

 ;

EN3 ; REPRINT PURCHASE ORDERS PRINTED IN FISCAL

 D ST Q:'$D(PRC("SITE"))  S M1="Purchase Orders",M2="Fiscal",M5="P1"

 G SELLST

 ;

EN4 ; REPRINT PURCHASE ORDERS PRINTED IN A&MM AFTER OBLIGATION

 D ST Q:'$D(PRC("SITE"))  S M1="Purchase Orders",M2="A&MM after Obligation",M5="P2"

 G SELLST

 ;

EN5 ; REPRINT RECEIVING REPORTS PRINTED IN FISCAL

 D ST Q:'$D(PRC("SITE"))  S M1="Receiving Reports",M2="Fiscal",M5="P3"

 G SELLST

 ;

SELLST ; SELECT LIST TO BE REPRINTED

 S PRCHPGM="PRCHRPT6" W !! S DIC="^PRC(443.5,",DIC(0)="AEQMOZ",DIC("S")="I $P(^(0),U,2)=M5",DIC("A")="Select "_M1_" Print List Number: " D ^DIC K DIC G:Y=-1 EXIT^PRCHRPT5

 S PRCHREC=+Y,Y=+$P(Y(0),U,3) D DD^%DT S M3=Y,Y=+$P(Y(0),U,4) D DD^%DT S M4=Y

 W ! S %A="Display list ",%B="",%=2 D ^PRCFYN G:%=-1 EXIT^PRCHRPT5 G:%=0 SELLST I %=1 D HOME^%ZIS D PR1^PRCHRPT8

 S PRCHALL="N" W !!,"Do you want to * REPRINT ALL * "_M1_" previously printed in "_M2,!,"  between "_M3_" and "_M4 S %B="",%=2 D ^PRCFYN G:%=-1 EXIT^PRCHRPT5 G:%=0 SELLST S:%=1 PRCHALL="Y"

 I PRCHALL="N" W !!,"Do you want to * REPRINT ANY * "_M1_" previously printed in "_M2,!,"  between "_M3_" and "_M4 S %B="",%=2 D ^PRCFYN G:%=-1 EXIT^PRCHRPT5 G:%'=1 DELLST W !!

 W:M5="P3" "P.O.# - Partial #",!

 S PRCHTRX="" F PRCHI5=0:0 S PRCHTRX=$O(^PRC(443.5,PRCHREC,1,"B",PRCHTRX)) Q:PRCHTRX=""  S I=$O(^(PRCHTRX,0)) I I,$D(^PRC(443.5,PRCHREC,1,I,0)) S Y=$P(^(0),U,3),DA=+$P(^(0),U,2) D DD^%DT W !,PRCHTRX,?23,Y D PRT Q:PRCHEX="^"

 G:PRCHEX="^" EXIT^PRCHRPT5

 G DELLST

 ;

PRT S PRCHEX="" I PRCHALL'="Y" W ?45,"Reprint " S %B="",%=2 D ^PRCFYN S:%=-1 PRCHEX="^" Q:%'=1

 S PRCHREPR=1

 D:M1="Requests" P11 D:M5="P3" P14 I M1="Purchase Orders" D:M5="P1" P12 D:M5="P2" P13

 Q

 ;

DELLST W !!,"Do you want to * DELETE THE LIST * of "_M1_" previously printed",!,"in "_M2,!,"  between "_M3_" and "_M4 S %B="",%=2 D ^PRCFYN G:%=0 W G:%'=1 EXIT^PRCHRPT5

 S DIK="^PRC(443.5,",DA=PRCHREC D ^DIK K DIK W !!!,$C(7),"  *** LIST DELETED ***"

 G EXIT^PRCHRPT5

 ;

P11 ; REPRINT REQUESTS (2237'S OR 1138'S) IN FISCAL OR A&MM

 N PPMFLG S PPMFLG=1

 Q:'$D(^PRCS(410,DA,0))  S D0=DA,PRCHQ=$P(^(0),U,4),PRCHQ=$S(PRCHQ=1:"QUE^PRCSP11",1:"QUE^PRCSP12"),PRCHQ("DEST")=$S(PRCHQ="QUE^PRCSP11":"F",1:"S") D ^PRCHQUE

 Q

 ;

P12 ; REPRINT P.O.'S IN FISCAL

 Q:'$D(^PRC(442,DA,0))  S D0=DA,PRCHQ="^PRCHFPNT" S:$D(^PRC(411,PRC("SITE"),2,"AC","F")) PRCHQ("DEST")="F" D ^PRCHQUE K ZTSK

 Q

 ;

P13 ; REPRINT P.O.'S FROM FISCAL TO A&MM AFTER OBLIGATION

 Q:'$D(^PRC(442,DA,0))  S D0=DA,X=$P(^PRC(411,PRC("SITE"),0),U,11),PRCHQ=$S(X=1:"^PRCHPNT",1:"^PRCHFPNT"),PRCHQ("DEST")="S8" D ^PRCHQUE

 Q

 ;

P14 ; REPRINT RECEIVING REPORTS IN FISCAL

 Q:'$D(^PRC(442,DA,0))  S D0=DA,PRCHFPT=$P(PRCHTRX,"-",3),PRCHQ="^PRCHFPNT",PRCHQ("DEST")="R",PRCHQ("DEST2")="FR" D ^PRCHQUE K ZTSK

 Q

 ;

W W !!,"This will not delete any of the "_M1_", it will only delete the",!,"list of those "_M1_" that were previously printed in "_M2_",",!,"between "_M3_" and "_M4_"."

 G DELLST

 ;

ST S PRCF("X")="SP" D ^PRCFSITE

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCHRPT6   3520     printed  Feb 18, 2025@23:36:56                                                                                                                                                                                                    Page 2

PRCHRPT6  ;BOISE/TKW-SUPPLEMENT TO PRCHRPT5--BUILD PRINT LOG OF REQUESTS/P.O.'S AND REPRINT ;4/27/89  9:59 AM ;2/19/92  3:50 PM

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

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

 +2       ;

EN1       ; REPRINT REQUESTS PRINTED IN A&MM (2237'S)

 +1        DO ST

           if '$DATA(PRC("SITE"))

               QUIT 

           SET M1="Requests"

           SET M2="A&MM (2237's)"

           SET M5="R1"

 +2        GOTO SELLST

 +3       ;

EN2       ; REPRINT REQUESTS PRINTED IN FISCAL (1358'S)

 +1        DO ST

           if '$DATA(PRC("SITE"))

               QUIT 

           SET M1="Requests"

           SET M2="Fiscal (1358's)"

           SET M5="R2"

 +2        GOTO SELLST

 +3       ;

EN3       ; REPRINT PURCHASE ORDERS PRINTED IN FISCAL

 +1        DO ST

           if '$DATA(PRC("SITE"))

               QUIT 

           SET M1="Purchase Orders"

           SET M2="Fiscal"

           SET M5="P1"

 +2        GOTO SELLST

 +3       ;

EN4       ; REPRINT PURCHASE ORDERS PRINTED IN A&MM AFTER OBLIGATION

 +1        DO ST

           if '$DATA(PRC("SITE"))

               QUIT 

           SET M1="Purchase Orders"

           SET M2="A&MM after Obligation"

           SET M5="P2"

 +2        GOTO SELLST

 +3       ;

EN5       ; REPRINT RECEIVING REPORTS PRINTED IN FISCAL

 +1        DO ST

           if '$DATA(PRC("SITE"))

               QUIT 

           SET M1="Receiving Reports"

           SET M2="Fiscal"

           SET M5="P3"

 +2        GOTO SELLST

 +3       ;

SELLST    ; SELECT LIST TO BE REPRINTED

 +1        SET PRCHPGM="PRCHRPT6"

           WRITE !!

           SET DIC="^PRC(443.5,"

           SET DIC(0)="AEQMOZ"

           SET DIC("S")="I $P(^(0),U,2)=M5"

           SET DIC("A")="Select "_M1_" Print List Number: "

           DO ^DIC

           KILL DIC

           if Y=-1

               GOTO EXIT^PRCHRPT5

 +2        SET PRCHREC=+Y

           SET Y=+$PIECE(Y(0),U,3)

           DO DD^%DT

           SET M3=Y

           SET Y=+$PIECE(Y(0),U,4)

           DO DD^%DT

           SET M4=Y

 +3        WRITE !

           SET %A="Display list "

           SET %B=""

           SET %=2

           DO ^PRCFYN

           if %=-1

               GOTO EXIT^PRCHRPT5

           if %=0

               GOTO SELLST

           IF %=1

               DO HOME^%ZIS

               DO PR1^PRCHRPT8

 +4        SET PRCHALL="N"

           WRITE !!,"Do you want to * REPRINT ALL * "_M1_" previously printed in "_M2,!,"  between "_M3_" and "_M4

           SET %B=""

           SET %=2

           DO ^PRCFYN

           if %=-1

               GOTO EXIT^PRCHRPT5

           if %=0

               GOTO SELLST

           if %=1

               SET PRCHALL="Y"

 +5        IF PRCHALL="N"

               WRITE !!,"Do you want to * REPRINT ANY * "_M1_" previously printed in "_M2,!,"  between "_M3_" and "_M4

               SET %B=""

               SET %=2

               DO ^PRCFYN

               if %=-1

                   GOTO EXIT^PRCHRPT5

               if %'=1

                   GOTO DELLST

               WRITE !!

 +6        if M5="P3"

               WRITE "P.O.# - Partial #",!

 +7        SET PRCHTRX=""

           FOR PRCHI5=0:0

               SET PRCHTRX=$ORDER(^PRC(443.5,PRCHREC,1,"B",PRCHTRX))

               if PRCHTRX=""

                   QUIT 

               SET I=$ORDER(^(PRCHTRX,0))

               IF I

                   IF $DATA(^PRC(443.5,PRCHREC,1,I,0))

                       SET Y=$PIECE(^(0),U,3)

                       SET DA=+$PIECE(^(0),U,2)

                       DO DD^%DT

                       WRITE !,PRCHTRX,?23,Y

                       DO PRT

                       if PRCHEX="^"

                           QUIT 

 +8        if PRCHEX="^"

               GOTO EXIT^PRCHRPT5

 +9        GOTO DELLST

 +10      ;

PRT        SET PRCHEX=""

           IF PRCHALL'="Y"

               WRITE ?45,"Reprint "

               SET %B=""

               SET %=2

               DO ^PRCFYN

               if %=-1

                   SET PRCHEX="^"

               if %'=1

                   QUIT 

 +1        SET PRCHREPR=1

 +2        if M1="Requests"

               DO P11

           if M5="P3"

               DO P14

           IF M1="Purchase Orders"

               if M5="P1"

                   DO P12

               if M5="P2"

                   DO P13

 +3        QUIT 

 +4       ;

DELLST     WRITE !!,"Do you want to * DELETE THE LIST * of "_M1_" previously printed",!,"in "_M2,!,"  between "_M3_" and "_M4

           SET %B=""

           SET %=2

           DO ^PRCFYN

           if %=0

               GOTO W

           if %'=1

               GOTO EXIT^PRCHRPT5

 +1        SET DIK="^PRC(443.5,"

           SET DA=PRCHREC

           DO ^DIK

           KILL DIK

           WRITE !!!,$CHAR(7),"  *** LIST DELETED ***"

 +2        GOTO EXIT^PRCHRPT5

 +3       ;

P11       ; REPRINT REQUESTS (2237'S OR 1138'S) IN FISCAL OR A&MM

 +1        NEW PPMFLG

           SET PPMFLG=1

 +2        if '$DATA(^PRCS(410,DA,0))

               QUIT 

           SET D0=DA

           SET PRCHQ=$PIECE(^(0),U,4)

           SET PRCHQ=$SELECT(PRCHQ=1:"QUE^PRCSP11",1:"QUE^PRCSP12")

           SET PRCHQ("DEST")=$SELECT(PRCHQ="QUE^PRCSP11":"F",1:"S")

           DO ^PRCHQUE

 +3        QUIT 

 +4       ;

P12       ; REPRINT P.O.'S IN FISCAL

 +1        if '$DATA(^PRC(442,DA,0))

               QUIT 

           SET D0=DA

           SET PRCHQ="^PRCHFPNT"

           if $DATA(^PRC(411,PRC("SITE"),2,"AC","F"))

               SET PRCHQ("DEST")="F"

           DO ^PRCHQUE

           KILL ZTSK

 +2        QUIT 

 +3       ;

P13       ; REPRINT P.O.'S FROM FISCAL TO A&MM AFTER OBLIGATION

 +1        if '$DATA(^PRC(442,DA,0))

               QUIT 

           SET D0=DA

           SET X=$PIECE(^PRC(411,PRC("SITE"),0),U,11)

           SET PRCHQ=$SELECT(X=1:"^PRCHPNT",1:"^PRCHFPNT")

           SET PRCHQ("DEST")="S8"

           DO ^PRCHQUE

 +2        QUIT 

 +3       ;

P14       ; REPRINT RECEIVING REPORTS IN FISCAL

 +1        if '$DATA(^PRC(442,DA,0))

               QUIT 

           SET D0=DA

           SET PRCHFPT=$PIECE(PRCHTRX,"-",3)

           SET PRCHQ="^PRCHFPNT"

           SET PRCHQ("DEST")="R"

           SET PRCHQ("DEST2")="FR"

           DO ^PRCHQUE

           KILL ZTSK

 +2        QUIT 

 +3       ;

W          WRITE !!,"This will not delete any of the "_M1_", it will only delete the",!,"list of those "_M1_" that were previously printed in "_M2_",",!,"between "_M3_" and "_M4_"."

 +1        GOTO DELLST

 +2       ;

ST         SET PRCF("X")="SP"

           DO ^PRCFSITE

 +1        QUIT