- PRCHEB ;ID/RSD,SF-ISC/TKW-EDIT ROUTINES FOR SUPPLY SYSTEM ;11-20-92/12:01
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- EN ;CANCEL UNOBLIGATED REQUISITION
- S PRCHNRQ=1 D EN7^PRCHEA K PRCHNRQ
- Q
- ;
- EN0 ;REMOVE 2237 FROM REQUISITION
- S PRCHNRQ=1 D ^PRCHE2 K PRCHNRQ
- Q
- ;
- EN1 ;AMENDMENT TO REQUISITION
- S PRCHNRQ=1 D EN6^PRCHEA K PRCHNRQ
- Q
- ;
- EN2 ;ADJUSTMENT VOUCHER TO RECV.REPORT FOR REQUISITION
- S (PRCHREQ,PRCHNRQ)=1 D EN14^PRCHE K PRCHNRQ
- Q
- ;
- EN3 ; CREATE A NEW IMPREST FUND P.O.
- D ST Q:'$D(PRC("SITE"))
- EN30 S PRCHP("A")="IMPREST FUND P.O.NO.: ",PRCHP("T")=7,PRCHP("S")=3 D EN^PRCHPAT Q:'$D(PRCHPO) D LCK1 G:'$D(DA) EN30 S X=1 D ENS^PRCHSTAT,^PRCHNPO L
- G EN30
- ;
- EN4 ;EDIT AN IMPREST FUND P.O.
- D ST Q:'$D(PRC("SITE"))
- ;
- EN40 S PRCHP("A")="IMPREST FUND P.O.NO.: ",PRCHP("S")="$P(^(0),U,2)=7" D EN3^PRCHPAT Q:'$D(PRCHPO) I X>9!'X W " ??",$C(7) G EN40
- D LCK1 G:'$D(DA) EN40 D ^PRCHNPO L
- G EN40
- ;
- EN5 ;RECEIVING FOR IMPREST FUND P.O.
- S PRCHPGM="EN5^PRCHEB",PRCHIMP=1 D ^PRCHREC K PRCHPGM,PRCHIMP
- Q
- ;
- EN6 ;CANCEL UNOBLIGATED IF P.O.
- S PRCHIMP=1 D EN7^PRCHEA K PRCHIMP
- Q
- ;
- EN7 ;REMOVE 2237 FROM IF P.O.
- S PRCHIMP=1 D ^PRCHE2 K PRCHIMP
- Q
- ;
- EN8 ;ENTER COMPLETED DEPOT/GSA PUSH P.O. IN REGISTER
- D ST Q:'$D(PRC("SITE"))
- W !!!,"NOTE: This option will just reserve the PAT (P.O.) numbers needed for",!,"a DEPOT or GSA PUSH transaction. It will take 3 entries to complete the",!
- W "order (Regular, Drugs & Subsistence). The Control Point obligated balance for",!
- W "the warehouse will NOT be updated. Both the PUSH RELEASE (acquisitions",!,"and the RECEIPTS RELEASE (receiving) LOG code sheets must be generated",!,"using the 'CREATE A CODE SHEET' option."
- EN80 S PRCHNRQ=1,PRCHP("A")="REQUISITION NUMBER",PRCHP("T")=8,PRCHP("S")=1,PRCHP("S2")=",$P(^(0),U,1)[""G""" D EN^PRCHPAT I '$D(PRCHPO) K PRCHNRQ G Q^PRCHEA
- D LCK1 G:'$D(DA) EN80 S PRCHPUSH=1,DIE=DIC,DR="[PRCHPUSH]" D ^DIE,EN3^PRCHNPO7 L
- G EN80
- ;
- EN9 ;EDIT COMPLETED DEPOT/GSA PUSH P.O. IN REGISTER
- D ST Q:'$D(PRC("SITE"))
- EN90 S PRCHNRQ=1,PRCHP("A")="REQUISITION NUMBER: ",PRCHP("T")=8,PRCHP("S")="$P(^(0),U,1)[""G""" D EN3^PRCHPAT I '$D(PRCHPO) K PRCHNRQ G Q^PRCHEA
- I X>9!'X W " ??",$C(7) G EN90
- D LCK1 G:'$D(DA) EN90 S PRCHPUSH=1,DIE=DIC,DR="[PRCHPUSH]" D ^DIE,EN3^PRCHNPO7 L
- G EN90
- ;
- ENA ;CHANGE DELIVERY DATE ON REQUISITION
- S PRCHNRQ=1 D EN12^PRCHE K PRCHNRQ
- Q
- ;
- ENB ;RETURN SUPPLY FUND P.O. FROM PPM TO P&C FOR RE-EDITING
- D ST Q:'$D(PRC("SITE"))
- ENB1 S PRCHP("S")="""137""[$P(^(0),U,2),$P(^(0),U,19)=2,$D(^(7)),$P(^(7),U,2)=22,$D(^PRC(442,""AE"",""N"",+Y))"
- D EN3^PRCHPAT G:Y'>0 Q
- W !,$C(7) S %A="Are you sure that you want to return this to P&C for re-editing"
- S %=1,%B="Answering 'YES' will remove the Purchasing Agent's signature so that they",%B(1)="can re-edit the P.O." D ^PRCFYN G:%=2 ENB1 I %<0 W !,"No Action Taken." R X:3 G ENB1
- S DA=PRCHPO D LCK1 G:'$D(DA) ENB1
- ;S $P(^PRC(442,DA,12),"^",2,3)="^",X=6 D ENS^PRCHSTAT W !,"Purchase Order has been returned, please notify P&C, IMMEDIATELY",$C(7),! L G Q
- D REMOVE^PRCHES5(DA) S X=6 D ENS^PRCHSTAT W !,"Purchase Order has been returned, please notify P&C, IMMEDIATELY",$C(7),! L
- G Q
- ;
- Q K DA,DIC,PRC,PRCF,PRCHP,PRCHPO
- Q
- ;
- LCK1 S DIC="^PRC(442,"
- ;
- LCK L @(DIC_DA_"):0") E W !,$C(7),"ANOTHER USER IS EDITING THIS ENTRY!" K DA
- Q
- ;
- ST S PRCF("X")="S" D ^PRCFSITE
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHEB 3461 printed Jan 18, 2025@03:08:18 Page 2
- PRCHEB ;ID/RSD,SF-ISC/TKW-EDIT ROUTINES FOR SUPPLY SYSTEM ;11-20-92/12:01
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- EN ;CANCEL UNOBLIGATED REQUISITION
- +1 SET PRCHNRQ=1
- DO EN7^PRCHEA
- KILL PRCHNRQ
- +2 QUIT
- +3 ;
- EN0 ;REMOVE 2237 FROM REQUISITION
- +1 SET PRCHNRQ=1
- DO ^PRCHE2
- KILL PRCHNRQ
- +2 QUIT
- +3 ;
- EN1 ;AMENDMENT TO REQUISITION
- +1 SET PRCHNRQ=1
- DO EN6^PRCHEA
- KILL PRCHNRQ
- +2 QUIT
- +3 ;
- EN2 ;ADJUSTMENT VOUCHER TO RECV.REPORT FOR REQUISITION
- +1 SET (PRCHREQ,PRCHNRQ)=1
- DO EN14^PRCHE
- KILL PRCHNRQ
- +2 QUIT
- +3 ;
- EN3 ; CREATE A NEW IMPREST FUND P.O.
- +1 DO ST
- if '$DATA(PRC("SITE"))
- QUIT
- EN30 SET PRCHP("A")="IMPREST FUND P.O.NO.: "
- SET PRCHP("T")=7
- SET PRCHP("S")=3
- DO EN^PRCHPAT
- if '$DATA(PRCHPO)
- QUIT
- DO LCK1
- if '$DATA(DA)
- GOTO EN30
- SET X=1
- DO ENS^PRCHSTAT
- DO ^PRCHNPO
- LOCK
- +1 GOTO EN30
- +2 ;
- EN4 ;EDIT AN IMPREST FUND P.O.
- +1 DO ST
- if '$DATA(PRC("SITE"))
- QUIT
- +2 ;
- EN40 SET PRCHP("A")="IMPREST FUND P.O.NO.: "
- SET PRCHP("S")="$P(^(0),U,2)=7"
- DO EN3^PRCHPAT
- if '$DATA(PRCHPO)
- QUIT
- IF X>9!'X
- WRITE " ??",$CHAR(7)
- GOTO EN40
- +1 DO LCK1
- if '$DATA(DA)
- GOTO EN40
- DO ^PRCHNPO
- LOCK
- +2 GOTO EN40
- +3 ;
- EN5 ;RECEIVING FOR IMPREST FUND P.O.
- +1 SET PRCHPGM="EN5^PRCHEB"
- SET PRCHIMP=1
- DO ^PRCHREC
- KILL PRCHPGM,PRCHIMP
- +2 QUIT
- +3 ;
- EN6 ;CANCEL UNOBLIGATED IF P.O.
- +1 SET PRCHIMP=1
- DO EN7^PRCHEA
- KILL PRCHIMP
- +2 QUIT
- +3 ;
- EN7 ;REMOVE 2237 FROM IF P.O.
- +1 SET PRCHIMP=1
- DO ^PRCHE2
- KILL PRCHIMP
- +2 QUIT
- +3 ;
- EN8 ;ENTER COMPLETED DEPOT/GSA PUSH P.O. IN REGISTER
- +1 DO ST
- if '$DATA(PRC("SITE"))
- QUIT
- +2 WRITE !!!,"NOTE: This option will just reserve the PAT (P.O.) numbers needed for",!,"a DEPOT or GSA PUSH transaction. It will take 3 entries to complete the",!
- +3 WRITE "order (Regular, Drugs & Subsistence). The Control Point obligated balance for",!
- +4 WRITE "the warehouse will NOT be updated. Both the PUSH RELEASE (acquisitions",!,"and the RECEIPTS RELEASE (receiving) LOG code sheets must be generated",!,"using the 'CREATE A CODE SHEET' option."
- EN80 SET PRCHNRQ=1
- SET PRCHP("A")="REQUISITION NUMBER"
- SET PRCHP("T")=8
- SET PRCHP("S")=1
- SET PRCHP("S2")=",$P(^(0),U,1)[""G"""
- DO EN^PRCHPAT
- IF '$DATA(PRCHPO)
- KILL PRCHNRQ
- GOTO Q^PRCHEA
- +1 DO LCK1
- if '$DATA(DA)
- GOTO EN80
- SET PRCHPUSH=1
- SET DIE=DIC
- SET DR="[PRCHPUSH]"
- DO ^DIE
- DO EN3^PRCHNPO7
- LOCK
- +2 GOTO EN80
- +3 ;
- EN9 ;EDIT COMPLETED DEPOT/GSA PUSH P.O. IN REGISTER
- +1 DO ST
- if '$DATA(PRC("SITE"))
- QUIT
- EN90 SET PRCHNRQ=1
- SET PRCHP("A")="REQUISITION NUMBER: "
- SET PRCHP("T")=8
- SET PRCHP("S")="$P(^(0),U,1)[""G"""
- DO EN3^PRCHPAT
- IF '$DATA(PRCHPO)
- KILL PRCHNRQ
- GOTO Q^PRCHEA
- +1 IF X>9!'X
- WRITE " ??",$CHAR(7)
- GOTO EN90
- +2 DO LCK1
- if '$DATA(DA)
- GOTO EN90
- SET PRCHPUSH=1
- SET DIE=DIC
- SET DR="[PRCHPUSH]"
- DO ^DIE
- DO EN3^PRCHNPO7
- LOCK
- +3 GOTO EN90
- +4 ;
- ENA ;CHANGE DELIVERY DATE ON REQUISITION
- +1 SET PRCHNRQ=1
- DO EN12^PRCHE
- KILL PRCHNRQ
- +2 QUIT
- +3 ;
- ENB ;RETURN SUPPLY FUND P.O. FROM PPM TO P&C FOR RE-EDITING
- +1 DO ST
- if '$DATA(PRC("SITE"))
- QUIT
- ENB1 SET PRCHP("S")="""137""[$P(^(0),U,2),$P(^(0),U,19)=2,$D(^(7)),$P(^(7),U,2)=22,$D(^PRC(442,""AE"",""N"",+Y))"
- +1 DO EN3^PRCHPAT
- if Y'>0
- GOTO Q
- +2 WRITE !,$CHAR(7)
- SET %A="Are you sure that you want to return this to P&C for re-editing"
- +3 SET %=1
- SET %B="Answering 'YES' will remove the Purchasing Agent's signature so that they"
- SET %B(1)="can re-edit the P.O."
- DO ^PRCFYN
- if %=2
- GOTO ENB1
- IF %<0
- WRITE !,"No Action Taken."
- READ X:3
- GOTO ENB1
- +4 SET DA=PRCHPO
- DO LCK1
- if '$DATA(DA)
- GOTO ENB1
- +5 ;S $P(^PRC(442,DA,12),"^",2,3)="^",X=6 D ENS^PRCHSTAT W !,"Purchase Order has been returned, please notify P&C, IMMEDIATELY",$C(7),! L G Q
- +6 DO REMOVE^PRCHES5(DA)
- SET X=6
- DO ENS^PRCHSTAT
- WRITE !,"Purchase Order has been returned, please notify P&C, IMMEDIATELY",$CHAR(7),!
- LOCK
- +7 GOTO Q
- +8 ;
- Q KILL DA,DIC,PRC,PRCF,PRCHP,PRCHPO
- +1 QUIT
- +2 ;
- LCK1 SET DIC="^PRC(442,"
- +1 ;
- LCK LOCK @(DIC_DA_"):0")
- IF '$TEST
- WRITE !,$CHAR(7),"ANOTHER USER IS EDITING THIS ENTRY!"
- KILL DA
- +1 QUIT
- +2 ;
- ST SET PRCF("X")="S"
- DO ^PRCFSITE
- +1 QUIT