- PRCSEB1 ;WISC/SAW,DGL-CONTROL POINT ACTIVITY EDITS CON'T; [7/21/98 3:35pm]
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ENOD ;ENTER OBLIGATION DATA
- W !,"This option is no longer in use." Q
- ENOD1 ;
- W !,"Committed (Estimated) Cost: " I $D(^PRCS(410,DA,4)),$P(^(4),U)]"" W ?28,$J($P(^(4),U),0,2)
- E W ?28,"None entered."
- S DR="[PRCSENOD]",DIE=DIC D ^DIE S:'$D(PRCS) PRCS=DA Q:$D(PRCSOB) G EXIT
- ENCAD ;ENTER FMS DATA
- D EN3^PRCSUT G W2:'$D(PRC("SITE")),EXIT:Y<0
- S DIC="^PRCS(410,",DIC(0)="AEQ",DIC("A")="Select PURCHASE ORDER/OBLIGATION NO: ",D="D"
- S DIC("S")="I +^(0),$D(^(3)),+^(3)=+$P(PRC(""CP""),"" ""),$P(^(0),""^"",5)=PRC(""SITE"") I $D(^PRC(420,""A"",DUZ,PRC(""SITE""),+PRC(""CP""),1))!($D(^(2)))" D ^PRCSDIC G EXIT:Y<0 K DIC("S"),DIC("A")
- S DA=+Y L +^PRCS(410,DA):15 G ENCAD:$T=0 S DIC(0)="AEMQ",DIE=DIC,DR="[PRCSENCAD]" D ^DIE L -^PRCS(410,DA) S T(1)="FMS (820)" D W3 G EXIT:%'=1 W !! G ENCAD
- ENA ;ENTER AN ADJUSTMENT
- N AMOUNT,PO,REC,PODATE,SITE
- D EN^PRCSUT G W2:'$D(PRC("SITE")) G EXIT:'$D(PRC("QTR"))!(Y<0)
- D EN1^PRCSUT3 Q:'X S X1=X D EN2^PRCSUT3 Q:'$D(X1) S X=X1 D W L +^PRCS(410,DA):15 G ENA:$T=0 S $P(^PRCS(410,DA,0),U,2)="A"
- D ADDADJ
- S T(1)="Adjustment" K PRCS58 D W3 G EXIT:%'=1 W !! G ENA
- ;
- ;D EN1^PRCSUT3 Q:'X S X1=X D EN2^PRCSUT3 Q:'$D(X1) S X=X1 D W L +^PRCS(410,DA):15 G ENA:$T=0 S $P(^PRCS(410,DA,0),U,2)="A"
- ;
- ADDADJ S DIE="^PRCS(410,",DR="450////O;449////"_$P($$QTRDATE^PRC0D(PRC("FY"),PRC("QTR")),"^",7) D ^DIE K DR
- ENA1 S DIC(0)="AEMQ",DIE=DIC,DR="24OBLIGATION NUMBER~R" D ^DIE K DR G CT:$D(Y)
- S SITE=PRC("SITE"),$P(^PRCS(410,DA,7),"^")=DUZ
- N PRCX442 S PRCX442=X,PRCX442=$$UPPER^PRCFFU5(PRCX442) D OBL^PRCSES2 S X=PRCX442
- S DIC(0)="AEMQ",DIE="^PRCS(410,"
- ENA2 K DR S DR="[PRCSENA]" I $D(PRCS58) S DR="[PRCSENA 1358]"
- D ^DIE G CT:$D(Y) I '$D(^PRCS(410,DA,4)) W $C(7),!,"You must enter an Adjustment $ Amount for this transaction.",! G ENA2
- I $D(^PRC(420,PRC("SITE"),1,+PRC("CP"),0)),$P(^(0),U,12)>0 G ENA3
- I $D(^PRCS(410,DA,4)) S X=$P(^(4),"^",6),X2=^(3),X1=$P(X2,"^",7)+$P(X2,"^",9) I $J(X,0,2)'=$J(X1,0,2) W $C(7),!,"Adjustment $ Amount does not equal the total of BOC $ Amounts.",!,"Please correct the error.",! G ENA2
- S AMOUNT=$P($G(^PRCS(410,DA,4)),"^",6),$P(^PRCS(410,DA,4),"^",8)=AMOUNT
- ENA3 ;D:$O(^PRCS(410,DA,12,0)) SCPC0^PRCSED
- S PO=$P($G(^PRCS(410,DA,4)),"^",5) I PO'="",$D(^PRC(442,"C",PO)) S REC=$O(^PRC(442,"C",PO,0)),PODATE=$P($G(^PRC(442,+REC,1)),"^",15) S DR="23///^S X=PODATE",DIE="^PRCS(410," D ^DIE
- L -^PRCS(410,DA)
- QUIT
- ENFIS ;from fiscal's option
- N PRC,AMOUNT,PO,REC,PODATE,SITE
- N A,B,C,X,Y,Z
- D SITE^PRCB0C G EXIT:'$G(PRC("SITE"))
- D SUBSITE^PRCB0C G EXIT:'$G(PRC("SST"))&$D(^PRC(411,"UP",+PRC("SITE")))
- D FY^PRCB0C G EXIT:PRC("FY")="^" D QTR^PRCB0C G EXIT:'$G(PRC("QTR"))
- D FCP^PRCB0C G EXIT:'$G(PRC("CP")) D BBFY^PRCB0C G:'$G(PRC("BBFY")) EXIT
- S Z=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$P(PRC("CP")," "),X=$P(Z,"-",1,2)_"-"_$P(PRC("CP")," ")
- D EN1^PRCSUT3 Q:'X S X1=X D EN2^PRCSUT3 Q:'$D(X1) S X=X1 D W L +^PRCS(410,DA):15 G ENFIS:$T=0 S $P(^PRCS(410,DA,0),U,2)="A"
- S DIE="^PRCS(410,",DR="25.5//NO" D ^DIE K DR G CT:$D(Y)
- D ADDADJ
- S T(1)="Adjustment" K PRCS58 D W3 G EXIT:%'=1 W !! G ENFIS
- CT ;CANCEL AN ADJUSTMENT TRANSACTION
- S T=$P(^PRCS(410,DA,0),"^"),$P(^(11),"^",3)="",$P(^(0),"^",2)="CA",$P(^(5),"^")=0,$P(^(6),"^")=0 K ^PRCS(410,"F",+T_"-"_+PRC("CP")_"-"_$P(T,"-",5),DA),^PRCS(410,"F1",$P(T,"-",5)_"-"_+T_"-"_+PRC("CP"),DA),^PRCS(410,"AQ",1,DA)
- K ZX I $D(^PRCS(410,DA,4)) S ZX=^(4),X=-$P(ZX,"^",8) D EBAL^PRCSEZ(PRC("SITE")_"^"_PRC("CP")_"^"_PRC("FY")_"^"_PRC("QTR")_"^"_X,"C") I $P(ZX,"^",14)'="Y" D EBAL^PRCSEZ(PRC("SITE")_"^"_PRC("CP")_"^"_PRC("FY")_"^"_PRC("QTR")_"^"_X,"O")
- F I=1,3,6,8 S $P(ZX,"^",I)=0
- I $D(ZX) S ^PRCS(410,DA,4)=ZX K ZX
- I $D(^PRCS(410,DA,12,0)) S N=0 F S N=$O(^PRCS(410,DA,12,N)) Q:N'>0 S X=$P(^(N,0),"^",2) I X S DA(1)=DA,DA=N D TRANK^PRCSEZZ S DA=DA(1)
- W !!,"This adjustment has been cancelled." G EXIT
- ENC ;ENTER CEILING TRANSACTION
- D EN^PRCSUT G W2:'$D(PRC("SITE")) G EXIT:'$D(PRC("QTR"))!(Y<0) D EN1^PRCSUT3 Q:'X S X1=X D EN2^PRCSUT3 Q:'$D(X1) S X=X1 D W L +^PRCS(410,DA):15 G ENC:$T=0 S DIC(0)="AEMQ",DIE=DIC,DR="[PRCSENC]" D ^DIE
- L -^PRCS(410,DA) S T(1)="Ceiling" D W3 G EXIT:%'=1 W !! G ENC
- CPU ;ENTER/EDIT CONTROL POINT USERS
- N PRCSSC S PRCSSC=0
- D EN3^PRCSUT G W2:'$D(PRC("SITE")),EXIT:Y<0 S DA(1)=PRC("SITE"),DA=+PRC("CP")
- I $D(PRCSC) S PRCSSC=PRCSC I '$D(^PRC(420,"A",DUZ,PRC("SITE"),+PRC("CP"),PRCSSC)) W !,"You cannot use this option for this control point." G EXIT
- CPU1 D EDIT^PRC0B(.X,"420;^PRC(420,;"_DA(1)_"~420.01;^PRC(420,"_DA(1)_",1,;"_DA,"12;6","L")
- I X=-2 D EN^DDIOL("Fund control point is in use, try later.")
- D TUSER(+$P(PRC("CP")," "))
- Q
- TUSER(CP) ;Check for IFCAP terminated users
- N A,XDA,ST,I,J
- W !!,"Checking for IFCAP terminated users...",!
- S XDA=0,ST=PRC("SITE"),I=0,J=0 F S XDA=$O(^PRC(420,ST,1,CP,1,XDA)) Q:XDA="" D
- . S A=$G(^VA(200,XDA,0))
- . I A="" D TUSER1 Q ;Dangling pointer removed
- . I $D(^PRC(411,ST,8,XDA,0))#10=1 S I=I+1 D TUSER1 W !?5,$P(A,"^",1)," is deactivated and was removed as a Control Point User *"
- . D NOW^%DTC
- . I $P(A,"^",11)>0,$P(A,"^",11)<X S J=J+1 D TUSER1 W !?5,$P(A,"^",1)," is terminated and was removed as a Control Point User **"
- W !!
- I I>0 W "* CONTACT THE IFCAP APPLICATION COORDINATOR TO REACTIVATE THE USER" W:I>1 "S" W " *",!
- I J>0 W "** CONTACT IRM TO REACTIVATE IN FILE 200 **",!
- I J+I=0 W ?5,"None found",!
- Q
- TUSER1 S DA=XDA,DA(1)=CP,DA(2)=ST,DIK="^PRC(420,"_DA(2)_",1,"_DA(1)_",1," D ^DIK K DIK
- Q
- SENDIT2 ;
- N XX,XMDUZ,XMSUB,XMTEXT S XMDUZ="IFCAP PROCESSING",XX=$P($G(^PRCS(410,PRCHSY,7)),"^",1) S:XX="" XX=$P($G(^PRCS(410,PRCHSY,7)),"^",3)
- S XMTEXT="PRCSAR(",XMSUB="SPLIT TRANSACTION NOTIFICATION",XMY(XX)=""
- D ^XMD Q
- W W !!,"This transaction is assigned transaction number: ",X Q
- W1 W !!,"Sorry, you are not allowed to overcommit funds for control point ",$P(PRC("CP")," "),".",!,"Your current balance of $",PRCST1," is insufficient to cover the cost ($",PRCST,")",!,"of this request. Contact Fiscal Service.",$C(7) Q
- W2 W !!,"You are not an authorized control point user.",!,"Contact your control point official." R X:5 G EXIT
- W3 W !!,"Would you like to enter another ",T(1)," transaction" S %=1 D YN^DICN G W3:%=0 Q
- EXIT K DA,DIC,DIE,DR,PRCS,PRCS58,PRCSL,T,X,X1,DLAYGO Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCSEB1 6453 printed Feb 18, 2025@23:43:53 Page 2
- PRCSEB1 ;WISC/SAW,DGL-CONTROL POINT ACTIVITY EDITS CON'T; [7/21/98 3:35pm]
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- ENOD ;ENTER OBLIGATION DATA
- +1 WRITE !,"This option is no longer in use."
- QUIT
- ENOD1 ;
- +1 WRITE !,"Committed (Estimated) Cost: "
- IF $DATA(^PRCS(410,DA,4))
- IF $PIECE(^(4),U)]""
- WRITE ?28,$JUSTIFY($PIECE(^(4),U),0,2)
- +2 IF '$TEST
- WRITE ?28,"None entered."
- +3 SET DR="[PRCSENOD]"
- SET DIE=DIC
- DO ^DIE
- if '$DATA(PRCS)
- SET PRCS=DA
- if $DATA(PRCSOB)
- QUIT
- GOTO EXIT
- ENCAD ;ENTER FMS DATA
- +1 DO EN3^PRCSUT
- if '$DATA(PRC("SITE"))
- GOTO W2
- if Y<0
- GOTO EXIT
- +2 SET DIC="^PRCS(410,"
- SET DIC(0)="AEQ"
- SET DIC("A")="Select PURCHASE ORDER/OBLIGATION NO: "
- SET D="D"
- +3 SET DIC("S")="I +^(0),$D(^(3)),+^(3)=+$P(PRC(""CP""),"" ""),$P(^(0),""^"",5)=PRC(""SITE"") I $D(^PRC(420,""A"",DUZ,PRC(""SITE""),+PRC(""CP""),1))!($D(^(2)))"
- DO ^PRCSDIC
- if Y<0
- GOTO EXIT
- KILL DIC("S"),DIC("A")
- +4 SET DA=+Y
- LOCK +^PRCS(410,DA):15
- if $TEST=0
- GOTO ENCAD
- SET DIC(0)="AEMQ"
- SET DIE=DIC
- SET DR="[PRCSENCAD]"
- DO ^DIE
- LOCK -^PRCS(410,DA)
- SET T(1)="FMS (820)"
- DO W3
- if %'=1
- GOTO EXIT
- WRITE !!
- GOTO ENCAD
- ENA ;ENTER AN ADJUSTMENT
- +1 NEW AMOUNT,PO,REC,PODATE,SITE
- +2 DO EN^PRCSUT
- if '$DATA(PRC("SITE"))
- GOTO W2
- if '$DATA(PRC("QTR"))!(Y<0)
- GOTO EXIT
- +3 DO EN1^PRCSUT3
- if 'X
- QUIT
- SET X1=X
- DO EN2^PRCSUT3
- if '$DATA(X1)
- QUIT
- SET X=X1
- DO W
- LOCK +^PRCS(410,DA):15
- if $TEST=0
- GOTO ENA
- SET $PIECE(^PRCS(410,DA,0),U,2)="A"
- +4 DO ADDADJ
- +5 SET T(1)="Adjustment"
- KILL PRCS58
- DO W3
- if %'=1
- GOTO EXIT
- WRITE !!
- GOTO ENA
- +6 ;
- +7 ;D EN1^PRCSUT3 Q:'X S X1=X D EN2^PRCSUT3 Q:'$D(X1) S X=X1 D W L +^PRCS(410,DA):15 G ENA:$T=0 S $P(^PRCS(410,DA,0),U,2)="A"
- +8 ;
- ADDADJ SET DIE="^PRCS(410,"
- SET DR="450////O;449////"_$PIECE($$QTRDATE^PRC0D(PRC("FY"),PRC("QTR")),"^",7)
- DO ^DIE
- KILL DR
- ENA1 SET DIC(0)="AEMQ"
- SET DIE=DIC
- SET DR="24OBLIGATION NUMBER~R"
- DO ^DIE
- KILL DR
- if $DATA(Y)
- GOTO CT
- +1 SET SITE=PRC("SITE")
- SET $PIECE(^PRCS(410,DA,7),"^")=DUZ
- +2 NEW PRCX442
- SET PRCX442=X
- SET PRCX442=$$UPPER^PRCFFU5(PRCX442)
- DO OBL^PRCSES2
- SET X=PRCX442
- +3 SET DIC(0)="AEMQ"
- SET DIE="^PRCS(410,"
- ENA2 KILL DR
- SET DR="[PRCSENA]"
- IF $DATA(PRCS58)
- SET DR="[PRCSENA 1358]"
- +1 DO ^DIE
- if $DATA(Y)
- GOTO CT
- IF '$DATA(^PRCS(410,DA,4))
- WRITE $CHAR(7),!,"You must enter an Adjustment $ Amount for this transaction.",!
- GOTO ENA2
- +2 IF $DATA(^PRC(420,PRC("SITE"),1,+PRC("CP"),0))
- IF $PIECE(^(0),U,12)>0
- GOTO ENA3
- +3 IF $DATA(^PRCS(410,DA,4))
- SET X=$PIECE(^(4),"^",6)
- SET X2=^(3)
- SET X1=$PIECE(X2,"^",7)+$PIECE(X2,"^",9)
- IF $JUSTIFY(X,0,2)'=$JUSTIFY(X1,0,2)
- WRITE $CHAR(7),!,"Adjustment $ Amount does not equal the total of BOC $ Amounts.",!,"Please correct the error.",!
- GOTO ENA2
- +4 SET AMOUNT=$PIECE($GET(^PRCS(410,DA,4)),"^",6)
- SET $PIECE(^PRCS(410,DA,4),"^",8)=AMOUNT
- ENA3 ;D:$O(^PRCS(410,DA,12,0)) SCPC0^PRCSED
- +1 SET PO=$PIECE($GET(^PRCS(410,DA,4)),"^",5)
- IF PO'=""
- IF $DATA(^PRC(442,"C",PO))
- SET REC=$ORDER(^PRC(442,"C",PO,0))
- SET PODATE=$PIECE($GET(^PRC(442,+REC,1)),"^",15)
- SET DR="23///^S X=PODATE"
- SET DIE="^PRCS(410,"
- DO ^DIE
- +2 LOCK -^PRCS(410,DA)
- +3 QUIT
- ENFIS ;from fiscal's option
- +1 NEW PRC,AMOUNT,PO,REC,PODATE,SITE
- +2 NEW A,B,C,X,Y,Z
- +3 DO SITE^PRCB0C
- if '$GET(PRC("SITE"))
- GOTO EXIT
- +4 DO SUBSITE^PRCB0C
- if '$GET(PRC("SST"))&$DATA(^PRC(411,"UP",+PRC("SITE")))
- GOTO EXIT
- +5 DO FY^PRCB0C
- if PRC("FY")="^"
- GOTO EXIT
- DO QTR^PRCB0C
- if '$GET(PRC("QTR"))
- GOTO EXIT
- +6 DO FCP^PRCB0C
- if '$GET(PRC("CP"))
- GOTO EXIT
- DO BBFY^PRCB0C
- if '$GET(PRC("BBFY"))
- GOTO EXIT
- +7 SET Z=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$PIECE(PRC("CP")," ")
- SET X=$PIECE(Z,"-",1,2)_"-"_$PIECE(PRC("CP")," ")
- +8 DO EN1^PRCSUT3
- if 'X
- QUIT
- SET X1=X
- DO EN2^PRCSUT3
- if '$DATA(X1)
- QUIT
- SET X=X1
- DO W
- LOCK +^PRCS(410,DA):15
- if $TEST=0
- GOTO ENFIS
- SET $PIECE(^PRCS(410,DA,0),U,2)="A"
- +9 SET DIE="^PRCS(410,"
- SET DR="25.5//NO"
- DO ^DIE
- KILL DR
- if $DATA(Y)
- GOTO CT
- +10 DO ADDADJ
- +11 SET T(1)="Adjustment"
- KILL PRCS58
- DO W3
- if %'=1
- GOTO EXIT
- WRITE !!
- GOTO ENFIS
- CT ;CANCEL AN ADJUSTMENT TRANSACTION
- +1 SET T=$PIECE(^PRCS(410,DA,0),"^")
- SET $PIECE(^(11),"^",3)=""
- SET $PIECE(^(0),"^",2)="CA"
- SET $PIECE(^(5),"^")=0
- SET $PIECE(^(6),"^")=0
- KILL ^PRCS(410,"F",+T_"-"_+PRC("CP")_"-"_$PIECE(T,"-",5),DA),^PRCS(410,"F1",$PIECE(T,"-",5)_"-"_+T_"-"_+PRC("CP"),DA),^PRCS(410,"AQ",1,DA)
- +2 KILL ZX
- IF $DATA(^PRCS(410,DA,4))
- SET ZX=^(4)
- SET X=-$PIECE(ZX,"^",8)
- DO EBAL^PRCSEZ(PRC("SITE")_"^"_PRC("CP")_"^"_PRC("FY")_"^"_PRC("QTR")_"^"_X,"C")
- IF $PIECE(ZX,"^",14)'="Y"
- DO EBAL^PRCSEZ(PRC("SITE")_"^"_PRC("CP")_"^"_PRC("FY")_"^"_PRC("QTR")_"^"_X,"O")
- +3 FOR I=1,3,6,8
- SET $PIECE(ZX,"^",I)=0
- +4 IF $DATA(ZX)
- SET ^PRCS(410,DA,4)=ZX
- KILL ZX
- +5 IF $DATA(^PRCS(410,DA,12,0))
- SET N=0
- FOR
- SET N=$ORDER(^PRCS(410,DA,12,N))
- if N'>0
- QUIT
- SET X=$PIECE(^(N,0),"^",2)
- IF X
- SET DA(1)=DA
- SET DA=N
- DO TRANK^PRCSEZZ
- SET DA=DA(1)
- +6 WRITE !!,"This adjustment has been cancelled."
- GOTO EXIT
- ENC ;ENTER CEILING TRANSACTION
- +1 DO EN^PRCSUT
- if '$DATA(PRC("SITE"))
- GOTO W2
- if '$DATA(PRC("QTR"))!(Y<0)
- GOTO EXIT
- DO EN1^PRCSUT3
- if 'X
- QUIT
- SET X1=X
- DO EN2^PRCSUT3
- if '$DATA(X1)
- QUIT
- SET X=X1
- DO W
- LOCK +^PRCS(410,DA):15
- if $TEST=0
- GOTO ENC
- SET DIC(0)="AEMQ"
- SET DIE=DIC
- SET DR="[PRCSENC]"
- DO ^DIE
- +2 LOCK -^PRCS(410,DA)
- SET T(1)="Ceiling"
- DO W3
- if %'=1
- GOTO EXIT
- WRITE !!
- GOTO ENC
- CPU ;ENTER/EDIT CONTROL POINT USERS
- +1 NEW PRCSSC
- SET PRCSSC=0
- +2 DO EN3^PRCSUT
- if '$DATA(PRC("SITE"))
- GOTO W2
- if Y<0
- GOTO EXIT
- SET DA(1)=PRC("SITE")
- SET DA=+PRC("CP")
- +3 IF $DATA(PRCSC)
- SET PRCSSC=PRCSC
- IF '$DATA(^PRC(420,"A",DUZ,PRC("SITE"),+PRC("CP"),PRCSSC))
- WRITE !,"You cannot use this option for this control point."
- GOTO EXIT
- CPU1 DO EDIT^PRC0B(.X,"420;^PRC(420,;"_DA(1)_"~420.01;^PRC(420,"_DA(1)_",1,;"_DA,"12;6","L")
- +1 IF X=-2
- DO EN^DDIOL("Fund control point is in use, try later.")
- +2 DO TUSER(+$PIECE(PRC("CP")," "))
- +3 QUIT
- TUSER(CP) ;Check for IFCAP terminated users
- +1 NEW A,XDA,ST,I,J
- +2 WRITE !!,"Checking for IFCAP terminated users...",!
- +3 SET XDA=0
- SET ST=PRC("SITE")
- SET I=0
- SET J=0
- FOR
- SET XDA=$ORDER(^PRC(420,ST,1,CP,1,XDA))
- if XDA=""
- QUIT
- Begin DoDot:1
- +4 SET A=$GET(^VA(200,XDA,0))
- +5 ;Dangling pointer removed
- IF A=""
- DO TUSER1
- QUIT
- +6 IF $DATA(^PRC(411,ST,8,XDA,0))#10=1
- SET I=I+1
- DO TUSER1
- WRITE !?5,$PIECE(A,"^",1)," is deactivated and was removed as a Control Point User *"
- +7 DO NOW^%DTC
- +8 IF $PIECE(A,"^",11)>0
- IF $PIECE(A,"^",11)<X
- SET J=J+1
- DO TUSER1
- WRITE !?5,$PIECE(A,"^",1)," is terminated and was removed as a Control Point User **"
- End DoDot:1
- +9 WRITE !!
- +10 IF I>0
- WRITE "* CONTACT THE IFCAP APPLICATION COORDINATOR TO REACTIVATE THE USER"
- if I>1
- WRITE "S"
- WRITE " *",!
- +11 IF J>0
- WRITE "** CONTACT IRM TO REACTIVATE IN FILE 200 **",!
- +12 IF J+I=0
- WRITE ?5,"None found",!
- +13 QUIT
- TUSER1 SET DA=XDA
- SET DA(1)=CP
- SET DA(2)=ST
- SET DIK="^PRC(420,"_DA(2)_",1,"_DA(1)_",1,"
- DO ^DIK
- KILL DIK
- +1 QUIT
- SENDIT2 ;
- +1 NEW XX,XMDUZ,XMSUB,XMTEXT
- SET XMDUZ="IFCAP PROCESSING"
- SET XX=$PIECE($GET(^PRCS(410,PRCHSY,7)),"^",1)
- if XX=""
- SET XX=$PIECE($GET(^PRCS(410,PRCHSY,7)),"^",3)
- +2 SET XMTEXT="PRCSAR("
- SET XMSUB="SPLIT TRANSACTION NOTIFICATION"
- SET XMY(XX)=""
- +3 DO ^XMD
- QUIT
- W WRITE !!,"This transaction is assigned transaction number: ",X
- QUIT
- W1 WRITE !!,"Sorry, you are not allowed to overcommit funds for control point ",$PIECE(PRC("CP")," "),".",!,"Your current balance of $",PRCST1," is insufficient to cover the cost ($",PRCST,")",!,"of this request. Contact Fiscal Service.",$CHAR(7)
- QUIT
- W2 WRITE !!,"You are not an authorized control point user.",!,"Contact your control point official."
- READ X:5
- GOTO EXIT
- W3 WRITE !!,"Would you like to enter another ",T(1)," transaction"
- SET %=1
- DO YN^DICN
- if %=0
- GOTO W3
- QUIT
- EXIT KILL DA,DIC,DIE,DR,PRCS,PRCS58,PRCSL,T,X,X1,DLAYGO
- QUIT
