source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSUT31.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
RevLine 
[613]1PRCSUT31 ;WISC/CTB/ISC6/LJP/WISC/CLH-TRANSACTION UTILITY PROGRAM ;4/30/92 9:19 AM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;RETRIEVE NEXT SEQUENCE NUMBER
5EN1 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
11T 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)
14OUT K DA,DIC,N,NODE,PIECE,PRCS("TYPE"),PRCSL,T,Z Q
15OUT1 S X="",Y=-1 D OUT Q
16EXIT 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
Note: See TracBrowser for help on using the repository browser.