| [613] | 1 | PRCHRCS7 ;SF/TKW,WISC/RWS-PRINT REPORTS SHOWING WHAT DEPOT LOG CODE SHEETS NEED TO BE GENERATED ;3-25-91/08:11
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN S PRCHSAVQ=PRCHQ,PRCHQ=PRCHQ_"^PRCHRCS7",PRCHQ("DEST")="S" D ^PRCHQUE
|
|---|
| 6 | S PRCH=$S(PRCHSAVQ["EN1":"AE",PRCHSAVQ["EN2":"AF",1:"") I PRCH="" G Q2
|
|---|
| 7 | F PRCHPO=0:0 S PRCHPO=$O(^PRC(442,PRCH,"N",PRCHPO)) Q:'PRCHPO I $D(^PRC(442,PRCHPO,0)),+^(0)=PRC("SITE"),$D(^(1)),$P(^(1),U,18)="N" W $P(^(0),U,1),! D DELE
|
|---|
| 8 | ;
|
|---|
| 9 | Q2 K PRCH,PRCHSAVQ,PRCHQ Q
|
|---|
| 10 | ;
|
|---|
| 11 | EN1 ;PRINT REPORT OF ACQUISITIONS CODE SHEETS TO BE DONE
|
|---|
| 12 | S PRCHRPT=1,PRCH="AE" G RD
|
|---|
| 13 | ;
|
|---|
| 14 | EN2 ;PRINT REPORT OF RECV.REPORT CODE SHEETS TO BE DONE
|
|---|
| 15 | S PRCHRPT=2,PRCH="AF"
|
|---|
| 16 | ;
|
|---|
| 17 | RD K ^TMP($J) S Y=DT D DD^%DT S PRCHDT=Y,PRCHPAGE=0 D HD
|
|---|
| 18 | F PRCHPO=0:0 S PRCHPO=$O(^PRC(442.8,PRCH,"N",PRCHPO)) Q:'PRCHPO I $D(^PRC(442,PRCHPO,0)) S X=$P(^(0),U,1) I +X=PRC("SITE") S ^TMP($J,$P(X,"-",2))=PRCHPO I $D(^PRC(442,PRCHPO,1)),$P(^(1),U,18)="N" S $P(^TMP($J,$P(X,"-",2)),U,2)="**"
|
|---|
| 19 | S PRCHPONO=""
|
|---|
| 20 | F J=0:0 S PRCHPONO=$O(^TMP($J,PRCHPONO)) Q:PRCHPONO="" S PRCHPO=$P(^(PRCHPONO),U,1),PRCHNON=$P(^(PRCHPONO),U,2) D P1 I PRCHRPT=2 F PRCHFPT=0:0 S PRCHFPT=$O(^PRC(442.8,"AF","N",PRCHPO,PRCHFPT)) Q:'PRCHFPT D P2
|
|---|
| 21 | G Q
|
|---|
| 22 | ;
|
|---|
| 23 | P1 D:PRCHDY>60 HD
|
|---|
| 24 | W !,?1,PRCHNON,?4,PRCHPONO D PODATA W ?15,Y,?30,PRCHMOP,?62,PRCHSFC,!,?7,PRCHVND S PRCHDY=PRCHDY+2 I PRCHRPT=1 W ! S PRCHDY=PRCHDY+1
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | PODATA S X=^PRC(442,PRCHPO,0)
|
|---|
| 28 | S PRCHMOP=$P($G(^PRCD(442.5,+$P(X,U,2),0)),U,1)
|
|---|
| 29 | S Y=$P(^DD(442,.03,0),U,3),PRCHSFC=$P(X,U,19) I PRCHSFC F I=1:1 S X=$P(Y,";",I) Q:X="" I $P(X,":",1)=PRCHSFC S PRCHSFC=$P(X,":",2) Q
|
|---|
| 30 | S Y=$G(^PRC(442,PRCHPO,1)),PRCHVND=$P($G(^PRC(440,+Y,0)),U,1),Y=+$P(Y,U,15) D DD^%DT
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | P2 Q:'$D(^PRC(442,PRCHPO,11,PRCHFPT,0)) S Y=+^(0) D DD^%DT S PRCHRDT=Y D:PRCHDY>60 HD W ?45,$J(PRCHFPT,6),?57,PRCHRDT,! S PRCHDY=PRCHDY+1
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | HD S PRCHPAGE=PRCHPAGE+1 W @IOF,$S(PRCHRPT=1:"DEPOT DUE-INS",1:"RECEIVING REPORTS")_" NEEDING LOG CODE SHEETS--STATION: ",PRC("SITE"),?67,PRCHDT,?88,"PAGE ",PRCHPAGE,!
|
|---|
| 37 | ;W ?1,"(NOTE: ** INDICATES NONEXPENDABLE ORDERS)",!
|
|---|
| 38 | W ?4,"P.O.NO.",?15,"P.O.DATE",?30,"METHOD OF PROCESSING",?62,"SPECIAL FUND CONTROL POINT",!,?7,"VENDOR"
|
|---|
| 39 | I PRCHRPT=2 W ?45,"PARTIAL",?57,"DATE RECEIVED"
|
|---|
| 40 | W ! F J=0:1:(IOM-2) W "-"
|
|---|
| 41 | W ! S PRCHDY=5
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | Q W $C(13),! K X,Y,I,J,PRCH,PRCHDT,PRCHDY,PRCHFPT,PRCHMOP,PRCHNON,PRCHPAGE,PRCHPO,PRCHPONO,PRCHRDT,PRCHRPT,PRCHSFC,PRCHVND
|
|---|
| 45 | I $D(ZTSK) D KILL^%ZTLOAD
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
| 48 | DELE ;DELETE NON-EXPENDABLE ORDERS FROM LIST OF ORDERS NEEDING CODE-SHEETS PROCESSED.
|
|---|
| 49 | I PRCH="AE" S DIE="^PRC(442,",DA=PRCHPO,DR="103.5///@" D ^DIE K DIE,DA,DR Q
|
|---|
| 50 | F PRCHFPT=0:0 S PRCHFPT=$O(^PRC(442,"AF","N",PRCHPO,PRCHFPT)) Q:'PRCHFPT S DIE="^PRC(442,"_PRCHPO_",11,",DA(1)=PRCHPO,DA=PRCHFPT,DR="19.2///@" D ^DIE K DIE,DA,DR
|
|---|
| 51 | Q
|
|---|
