| 1 | PRCSUT31 ;WISC/CTB/ISC6/LJP/WISC/CLH-TRANSACTION UTILITY PROGRAM ;4/30/92 9:19 AM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;RETRIEVE NEXT SEQUENCE NUMBER
|
|---|
| 5 | EN1 G:'$D(X) OUT1 G:'$D(PRCS("TYPE")) OUT1 G:'X OUT1 I $O(^PRC(442,"B",X,0))'>0 S (X,Y)="" G OUT
|
|---|
| 6 | S T(1)=$O(^DD(410.1,"B",PRCS("TYPE"),0)) G:'T(1)!('$D(^DD(410.1,+T(1),0))) OUT1 S T(1)=$P(^(0),U,4),NODE(1)=+T(1),PIECE(1)=$P(T(1),";",2)
|
|---|
| 7 | S DIC="^PRCS(410.1," I $D(^PRCS(410.1,"B",X)) S N="",N=$O(^PRCS(410.1,"B",X,N)),DA=N
|
|---|
| 8 | I '$D(^PRCS(410.1,"B",X)) S DLAYGO=410.1,DIC="^PRCS(410.1,",DIC(0)="FLXZ" D ^DIC K DLAYGO G:Y<0 OUT1 S DA=+Y,X=$P(Y,U,2)
|
|---|
| 9 | L +^PRCS(410.1,DA,0):15 G:$T=0 OUT
|
|---|
| 10 | S Z=X,T=$P(^PRCS(410.1,DA,NODE(1)),"^",PIECE(1))+1 S:T'>$P(^(0),U,2) T=$P(^(0),U,2)+1 S:T<1 T=1
|
|---|
| 11 | T S T="000"_T,T=$E(T,$L(T)-3,$L(T))
|
|---|
| 12 | S X=X_"-"_T I $D(^PRC(424,"B",X))!$D(^PRCS(410,"B",X))!$D(^PRC(442,"B",X)) S T=+T+1,X=Z G T
|
|---|
| 13 | S $P(^PRCS(410.1,DA,NODE(1)),U,PIECE(1))=+T,$P(^(0),U,2)=+T,$P(^(0),U,3)=DT S Y=T L -^PRCS(410.1,DA,0)
|
|---|
| 14 | OUT K DA,DIC,N,NODE,PIECE,PRCS("TYPE"),PRCSL,T,Z Q
|
|---|
| 15 | OUT1 S X="",Y=-1 D OUT Q
|
|---|
| 16 | EXIT K %,DA,DIC,DIE,DR,I,L,N,PRCS,PRCSAPP,PRCSIP,PRCSDIC,PRC("FY"),PRCSL,PRCSNW,PRC("QTR"),T,T0,T1,T2,T3,T4,X,X1,Z Q
|
|---|
