- PRCHAMY4 ;WISC/DJM-PRINT AMENDMENT,ROUTINE #4 ;12/13/95 2:44 PM
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- E31 ;Change VENDOR
- N CHANGE,OLD,VEN,LCNT,DATA
- S CHANGE=0 D LCNT^PRCHPAM5(.LCNT)
- F S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,5,CHANGE)) Q:CHANGE'>0 D
- .S OLD=$G(^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)),OLD=$P($G(^PRC(440,OLD,0)),U)
- .S VEN=$P($G(^PRC(442,PRCHPO,1)),U),VEN=$P($G(^PRC(440,VEN,0)),U)
- .D LINE^PRCHPAM5(.LCNT,2) S DATA="Vendor "_OLD_" has been changed to "_VEN
- .D DATA^PRCHPAM5(.LCNT,DATA),LCNT1^PRCHPAM5(LCNT)
- Q
- ;
- E32 ;REPLACE P.O. NUMBER
- N CHANGE,NPO,OPO,LCNT,DATA
- S CHANGE=0 D LCNT^PRCHPAM5(.LCNT)
- F S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,28,CHANGE)) Q:CHANGE'>0 D
- .S NPO=$P($G(^PRC(442,PRCHPO,23)),U,4),NPO=$P($G(^PRC(442,NPO,0)),U)
- .S OPO=$P($G(^PRC(442,PRCHPO,0)),U)
- .D LINE^PRCHPAM5(.LCNT,2) S DATA="Purchase Order number "_OPO_" has been changed to "_NPO
- .D DATA^PRCHPAM5(.LCNT,DATA),LCNT1^PRCHPAM5(LCNT)
- Q
- ;
- E34 ;AUTHORITY Edit PRINT
- N CHANGE,CHANGES,OLD,NEW,LCNT,DATA,DT2,I
- S CHANGE=0 D LCNT^PRCHPAM5(.LCNT)
- F S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,3,CHANGE)) Q:CHANGE'>0 D
- .S CHANGES=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,0),OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)
- .S NEW=$P(^PRC(442,PRCHPO,6,PRCHAM,0),U,4)
- .D LINE^PRCHPAM5(.LCNT,2)
- .I OLD=0 S DATA=" *ADDED THROUGH AMENDMENT*" D DATA^PRCHPAM5(.LCNT,DATA) D
- ..S DATA="Authority Edit is",DT2=$P(^PRCD(442.2,NEW,0),U,2) D D DATA^PRCHPAM5(.LCNT,DATA)
- ...I $L(DATA)+$L(DT2)>239 S DATA=DATA_":" D DATA^PRCHPAM5(.LCNT,DATA) S DATA=DT2 Q
- ...S DATA=DATA_" "_DT2
- .I OLD>0 S DATA="Authority Edit " D D DATA^PRCHPAM5(.LCNT,DATA)
- ..F I=1:1:3 S DT2=$S(I=1:$P(^PRCD(442.2,OLD,0),U,2),I=2:" has been changed to ",I=3:$P(^PRCD(442.2,NEW,0),U,2)) D CHK(.DATA,DT2)
- .D LCNT1^PRCHPAM5(LCNT)
- .Q
- Q
- CHK(DATA,DT2) ;
- I $L(DATA)+$L(DT2)<241 S DATA=DATA_DT2 Q
- D DATA^PRCHPAM5(.LCNT,DATA) S DATA=DT2
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHAMY4 2030 printed Mar 13, 2025@21:10:45 Page 2
- PRCHAMY4 ;WISC/DJM-PRINT AMENDMENT,ROUTINE #4 ;12/13/95 2:44 PM
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 ;
- E31 ;Change VENDOR
- +1 NEW CHANGE,OLD,VEN,LCNT,DATA
- +2 SET CHANGE=0
- DO LCNT^PRCHPAM5(.LCNT)
- +3 FOR
- SET CHANGE=$ORDER(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,5,CHANGE))
- if CHANGE'>0
- QUIT
- Begin DoDot:1
- +4 SET OLD=$GET(^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0))
- SET OLD=$PIECE($GET(^PRC(440,OLD,0)),U)
- +5 SET VEN=$PIECE($GET(^PRC(442,PRCHPO,1)),U)
- SET VEN=$PIECE($GET(^PRC(440,VEN,0)),U)
- +6 DO LINE^PRCHPAM5(.LCNT,2)
- SET DATA="Vendor "_OLD_" has been changed to "_VEN
- +7 DO DATA^PRCHPAM5(.LCNT,DATA)
- DO LCNT1^PRCHPAM5(LCNT)
- End DoDot:1
- +8 QUIT
- +9 ;
- E32 ;REPLACE P.O. NUMBER
- +1 NEW CHANGE,NPO,OPO,LCNT,DATA
- +2 SET CHANGE=0
- DO LCNT^PRCHPAM5(.LCNT)
- +3 FOR
- SET CHANGE=$ORDER(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,28,CHANGE))
- if CHANGE'>0
- QUIT
- Begin DoDot:1
- +4 SET NPO=$PIECE($GET(^PRC(442,PRCHPO,23)),U,4)
- SET NPO=$PIECE($GET(^PRC(442,NPO,0)),U)
- +5 SET OPO=$PIECE($GET(^PRC(442,PRCHPO,0)),U)
- +6 DO LINE^PRCHPAM5(.LCNT,2)
- SET DATA="Purchase Order number "_OPO_" has been changed to "_NPO
- +7 DO DATA^PRCHPAM5(.LCNT,DATA)
- DO LCNT1^PRCHPAM5(LCNT)
- End DoDot:1
- +8 QUIT
- +9 ;
- E34 ;AUTHORITY Edit PRINT
- +1 NEW CHANGE,CHANGES,OLD,NEW,LCNT,DATA,DT2,I
- +2 SET CHANGE=0
- DO LCNT^PRCHPAM5(.LCNT)
- +3 FOR
- SET CHANGE=$ORDER(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,3,CHANGE))
- if CHANGE'>0
- QUIT
- Begin DoDot:1
- +4 SET CHANGES=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,0)
- SET OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)
- +5 SET NEW=$PIECE(^PRC(442,PRCHPO,6,PRCHAM,0),U,4)
- +6 DO LINE^PRCHPAM5(.LCNT,2)
- +7 IF OLD=0
- SET DATA=" *ADDED THROUGH AMENDMENT*"
- DO DATA^PRCHPAM5(.LCNT,DATA)
- Begin DoDot:2
- +8 SET DATA="Authority Edit is"
- SET DT2=$PIECE(^PRCD(442.2,NEW,0),U,2)
- Begin DoDot:3
- +9 IF $LENGTH(DATA)+$LENGTH(DT2)>239
- SET DATA=DATA_":"
- DO DATA^PRCHPAM5(.LCNT,DATA)
- SET DATA=DT2
- QUIT
- +10 SET DATA=DATA_" "_DT2
- End DoDot:3
- DO DATA^PRCHPAM5(.LCNT,DATA)
- End DoDot:2
- +11 IF OLD>0
- SET DATA="Authority Edit "
- Begin DoDot:2
- +12 FOR I=1:1:3
- SET DT2=$SELECT(I=1:$PIECE(^PRCD(442.2,OLD,0),U,2),I=2:" has been changed to ",I=3:$PIECE(^PRCD(442.2,NEW,0),U,2))
- DO CHK(.DATA,DT2)
- End DoDot:2
- DO DATA^PRCHPAM5(.LCNT,DATA)
- +13 DO LCNT1^PRCHPAM5(LCNT)
- +14 QUIT
- End DoDot:1
- +15 QUIT
- CHK(DATA,DT2) ;
- +1 IF $LENGTH(DATA)+$LENGTH(DT2)<241
- SET DATA=DATA_DT2
- QUIT
- +2 DO DATA^PRCHPAM5(.LCNT,DATA)
- SET DATA=DT2
- +3 QUIT
