- PRCFFUA1 ;WISC/SJG-ROUTINE TO PROCESS OBLIGATIONS ;4/27/94 11:30
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- SC ; Display Obligation Data
- N LABEL S LABEL=$P(PO(0),U,2),PRCFA("IDES")=$S((LABEL=1)!(LABEL=2):"Purchase Order",LABEL=8:"Requisition",1:"Purchase Order")
- I '$D(IOF)!('$D(IOM)) S IOP="HOME" D ^%ZIS K POP
- W @IOF D HDR I $P(PRCFA("MOD"),U)="M" D ORG
- K II W !!?(IOM-37\2),PRCFA("IDES")_" - "_$P(PO(0),"^"),!!," COST CENTER: "_$P(PO(0),"^",5),?IOM\2-4,"CONTROL POINT: "_$P(PO(0),"^",3)
- W ! S II=0 F S II=$O(^PRC(442,PRCFA("PODA"),22,II)) Q:(II="")!(II'>0) D
- .N BOC,SHIP
- .S BOC=^PRC(442,PRCFA("PODA"),22,II,0),SHIP=+BOC
- .Q:'SHIP
- .W !,?$X+3,"BOC: ",$P(BOC,U),?IOM\2,"AMOUNT: $ "_$J($P(BOC,U,2),10,2)
- D GENDIQ^PRCFFU7(442,+PO,13.05,"E","")
- I $G(PRCTMP(442,+PO,13.05,"E")) D
- .K MSG W !!
- .S MSG(1)=" ESTIMATED SHIPPING BOC:"
- .S MSG(2)=" "_$G(PRCTMP(442,+PO,13.05,"E"))
- .D EN^DDIOL(.MSG) K MSG
- .Q
- W !!,"Net Cost of Order: ",?30,"$",$J($P(PO(0),U,16),10,2)
- I $P(PRCFA("MOD"),U)="M" D PAUSE^PRCFFERU
- Q
- CPBAL ; Display Control Point Offical's Balance
- D HDR
- W !!,"Net Cost of Order: ",?30,"$",$J($P(PO(0),U,16),10,2)
- D CPBAL^PRCFFMO1 I $D(PRCF("NOBAL")) K PRCF("NOBAL")
- I $P(PRC("PARAM"),"^",17)="Y" W !!,"Fiscal Status of Funds for Control Point" W !!,"Status of Funds Balance: ",?30,"$",$J($P(^PRC(420,PRC("SITE"),1,+$P(PO(0),U,3),0),U,7),10,2),!,"Estimated Balance:",?30,"$",$J($P(^(0),U,8),10,2)
- Q
- HDR ; Display header
- I '$D(IOINHI) D HILO^PRCFQ
- D HDR^PRCFFER
- Q
- ORG ; Display original info
- W !! K MSG S MSG(3)="The following information appears on the original and any previously amended"
- S MSG(4)=PRCFA("IDES") S:$D(^PRC(442,+PO,6)) MSG(4)=MSG(4)_"s" S MSG(4)=MSG(4)_":"
- I $G(PRCFA("RETRAN"))=1,$G(FISCEDIT)=1 S MSG(1)="These original values have been edited by Fiscal in this option!",MSG(2)=" "
- D EN^DDIOL(.MSG) K MSG W !
- Q
- GET ; Display amended BOC info
- D PAUSE^PRCFFERU,HDR S FILE=$$FILE^PRCFFUA()
- K MSG S MSG(1)="The following information appears on the amended "_PRCFA("IDES")
- S MSG(2)="as listed in the DESCRIPTION OF MODIFICATION:"
- W ! D EN^DDIOL(.MSG) W ! K MSG
- GETAMD I FILE=443.6 D Q
- .S D0=$S($D(PRCHPO):PRCHPO,1:D0),D1=$S($D(PRCHAM):PRCHAM,1:D1)
- .Q:'$D(^PRC(443.6,D0,6,D1)) S PRCHD0=^(D1,0),PRCHD1=^(1),PRCHDP0=^PRC(443.6,D0,0),PRCHDP1=^PRC(443.6,D0,1)
- .S PRCHDAV=$S($P(PRCHD0,U,8)="Y":1,1:0),PRCHLC1=6,PRCHLC2=0
- .D ITEM^PRCHDAM
- GETORG I FILE=442 D Q
- .D:$D(^PRC(442,D0,6,PRCFAA,3))
- ..K ^UTILITY($J,"W") D START^PRCHDP5(D0,PRCFAA)
- ..W ! S J=0 F S J=$O(^UTILITY($J,"W",1,J)) Q:'J W !,?8,^(J,0)
- ..Q
- .D:$D(^PRC(442,D0,6,PRCFAA,2))
- ..K ^UTILITY($J,"W") S DIWL=1,DIWR=60
- ..S PRCHJ=0 F S PRCHJ=$O(^PRC(442,D0,6,PRCFAA,2,PRCHJ)) Q:'PRCHJ S X=^(PRCHJ,0) D DIWP^PRCUTL($G(DA))
- ..W ! S J=0 F S J=$O(^UTILITY($J,"W",1,J)) Q:'J W !?8,^(J,0)
- ..Q
- .Q
- Q
- SF1 ; Line item roll-up into BOCs for amendment
- N LOOP,LAST,LOOPVAL S (LOOP,LAST)=0
- I $G(PRCFA("RETRAN"))=1 D ^PRCFFUA2
- S %X="^PRC(442,PRCHPO,22,",%Y="^PRC(443.6,PRCHPO,22," D %XY^%RCR
- F S LOOP=$O(^PRC(442,PRCHPO,22,LOOP)) Q:LOOP'>0 D
- .S LOOPVAL=$G(^PRC(442,PRCHPO,22,LOOP,0)),$P(LOOPVAL,U,2)=0
- .S ^PRC(442,PRCHPO,22,LOOP,0)=LOOPVAL I $P(LOOPVAL,U,3)'=991,$P(LOOPVAL,U,3)>LAST S LAST=$P(LOOPVAL,U,3)
- .Q
- S DA=PRCHPO D ^PRCHAMYC,^PRCHSF1
- K ^PRC(443.6,PRCHPO,22),%X,%Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFFUA1 3427 printed Feb 18, 2025@23:30:19 Page 2
- PRCFFUA1 ;WISC/SJG-ROUTINE TO PROCESS OBLIGATIONS ;4/27/94 11:30
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 ;
- SC ; Display Obligation Data
- +1 NEW LABEL
- SET LABEL=$PIECE(PO(0),U,2)
- SET PRCFA("IDES")=$SELECT((LABEL=1)!(LABEL=2):"Purchase Order",LABEL=8:"Requisition",1:"Purchase Order")
- +2 IF '$DATA(IOF)!('$DATA(IOM))
- SET IOP="HOME"
- DO ^%ZIS
- KILL POP
- +3 WRITE @IOF
- DO HDR
- IF $PIECE(PRCFA("MOD"),U)="M"
- DO ORG
- +4 KILL II
- WRITE !!?(IOM-37\2),PRCFA("IDES")_" - "_$PIECE(PO(0),"^"),!!," COST CENTER: "_$PIECE(PO(0),"^",5),?IOM\2-4,"CONTROL POINT: "_$PIECE(PO(0),"^",3)
- +5 WRITE !
- SET II=0
- FOR
- SET II=$ORDER(^PRC(442,PRCFA("PODA"),22,II))
- if (II="")!(II'>0)
- QUIT
- Begin DoDot:1
- +6 NEW BOC,SHIP
- +7 SET BOC=^PRC(442,PRCFA("PODA"),22,II,0)
- SET SHIP=+BOC
- +8 if 'SHIP
- QUIT
- +9 WRITE !,?$X+3,"BOC: ",$PIECE(BOC,U),?IOM\2,"AMOUNT: $ "_$JUSTIFY($PIECE(BOC,U,2),10,2)
- End DoDot:1
- +10 DO GENDIQ^PRCFFU7(442,+PO,13.05,"E","")
- +11 IF $GET(PRCTMP(442,+PO,13.05,"E"))
- Begin DoDot:1
- +12 KILL MSG
- WRITE !!
- +13 SET MSG(1)=" ESTIMATED SHIPPING BOC:"
- +14 SET MSG(2)=" "_$GET(PRCTMP(442,+PO,13.05,"E"))
- +15 DO EN^DDIOL(.MSG)
- KILL MSG
- +16 QUIT
- End DoDot:1
- +17 WRITE !!,"Net Cost of Order: ",?30,"$",$JUSTIFY($PIECE(PO(0),U,16),10,2)
- +18 IF $PIECE(PRCFA("MOD"),U)="M"
- DO PAUSE^PRCFFERU
- +19 QUIT
- CPBAL ; Display Control Point Offical's Balance
- +1 DO HDR
- +2 WRITE !!,"Net Cost of Order: ",?30,"$",$JUSTIFY($PIECE(PO(0),U,16),10,2)
- +3 DO CPBAL^PRCFFMO1
- IF $DATA(PRCF("NOBAL"))
- KILL PRCF("NOBAL")
- +4 IF $PIECE(PRC("PARAM"),"^",17)="Y"
- WRITE !!,"Fiscal Status of Funds for Control Point"
- WRITE !!,"Status of Funds Balance: ",?30,"$",$JUSTIFY($PIECE(^PRC(420,PRC("SITE"),1,+$PIECE(PO(0),U,3),0),U,7),10,2),!,"Estimated Balance:",?30,"$",$JUSTIFY($PIECE(^(0),U,8),10,2)
- +5 QUIT
- HDR ; Display header
- +1 IF '$DATA(IOINHI)
- DO HILO^PRCFQ
- +2 DO HDR^PRCFFER
- +3 QUIT
- ORG ; Display original info
- +1 WRITE !!
- KILL MSG
- SET MSG(3)="The following information appears on the original and any previously amended"
- +2 SET MSG(4)=PRCFA("IDES")
- if $DATA(^PRC(442,+PO,6))
- SET MSG(4)=MSG(4)_"s"
- SET MSG(4)=MSG(4)_":"
- +3 IF $GET(PRCFA("RETRAN"))=1
- IF $GET(FISCEDIT)=1
- SET MSG(1)="These original values have been edited by Fiscal in this option!"
- SET MSG(2)=" "
- +4 DO EN^DDIOL(.MSG)
- KILL MSG
- WRITE !
- +5 QUIT
- GET ; Display amended BOC info
- +1 DO PAUSE^PRCFFERU
- DO HDR
- SET FILE=$$FILE^PRCFFUA()
- +2 KILL MSG
- SET MSG(1)="The following information appears on the amended "_PRCFA("IDES")
- +3 SET MSG(2)="as listed in the DESCRIPTION OF MODIFICATION:"
- +4 WRITE !
- DO EN^DDIOL(.MSG)
- WRITE !
- KILL MSG
- GETAMD IF FILE=443.6
- Begin DoDot:1
- +1 SET D0=$SELECT($DATA(PRCHPO):PRCHPO,1:D0)
- SET D1=$SELECT($DATA(PRCHAM):PRCHAM,1:D1)
- +2 if '$DATA(^PRC(443.6,D0,6,D1))
- QUIT
- SET PRCHD0=^(D1,0)
- SET PRCHD1=^(1)
- SET PRCHDP0=^PRC(443.6,D0,0)
- SET PRCHDP1=^PRC(443.6,D0,1)
- +3 SET PRCHDAV=$SELECT($PIECE(PRCHD0,U,8)="Y":1,1:0)
- SET PRCHLC1=6
- SET PRCHLC2=0
- +4 DO ITEM^PRCHDAM
- End DoDot:1
- QUIT
- GETORG IF FILE=442
- Begin DoDot:1
- +1 if $DATA(^PRC(442,D0,6,PRCFAA,3))
- Begin DoDot:2
- +2 KILL ^UTILITY($JOB,"W")
- DO START^PRCHDP5(D0,PRCFAA)
- +3 WRITE !
- SET J=0
- FOR
- SET J=$ORDER(^UTILITY($JOB,"W",1,J))
- if 'J
- QUIT
- WRITE !,?8,^(J,0)
- +4 QUIT
- End DoDot:2
- +5 if $DATA(^PRC(442,D0,6,PRCFAA,2))
- Begin DoDot:2
- +6 KILL ^UTILITY($JOB,"W")
- SET DIWL=1
- SET DIWR=60
- +7 SET PRCHJ=0
- FOR
- SET PRCHJ=$ORDER(^PRC(442,D0,6,PRCFAA,2,PRCHJ))
- if 'PRCHJ
- QUIT
- SET X=^(PRCHJ,0)
- DO DIWP^PRCUTL($GET(DA))
- +8 WRITE !
- SET J=0
- FOR
- SET J=$ORDER(^UTILITY($JOB,"W",1,J))
- if 'J
- QUIT
- WRITE !?8,^(J,0)
- +9 QUIT
- End DoDot:2
- +10 QUIT
- End DoDot:1
- QUIT
- +11 QUIT
- SF1 ; Line item roll-up into BOCs for amendment
- +1 NEW LOOP,LAST,LOOPVAL
- SET (LOOP,LAST)=0
- +2 IF $GET(PRCFA("RETRAN"))=1
- DO ^PRCFFUA2
- +3 SET %X="^PRC(442,PRCHPO,22,"
- SET %Y="^PRC(443.6,PRCHPO,22,"
- DO %XY^%RCR
- +4 FOR
- SET LOOP=$ORDER(^PRC(442,PRCHPO,22,LOOP))
- if LOOP'>0
- QUIT
- Begin DoDot:1
- +5 SET LOOPVAL=$GET(^PRC(442,PRCHPO,22,LOOP,0))
- SET $PIECE(LOOPVAL,U,2)=0
- +6 SET ^PRC(442,PRCHPO,22,LOOP,0)=LOOPVAL
- IF $PIECE(LOOPVAL,U,3)'=991
- IF $PIECE(LOOPVAL,U,3)>LAST
- SET LAST=$PIECE(LOOPVAL,U,3)
- +7 QUIT
- End DoDot:1
- +8 SET DA=PRCHPO
- DO ^PRCHAMYC
- DO ^PRCHSF1
- +9 KILL ^PRC(443.6,PRCHPO,22),%X,%Y
- +10 QUIT