| 1 | PRCNEQS ;SSI/SEB-Equipment Committee status split ;[ 07/18/96 4:51 PM ]
|
|---|
| 2 | ;;1.0;Equipment/Turn-In Request;;Sep 13, 1996
|
|---|
| 3 | S (TRN,PTRN)=$P(^PRCN(413,IN,0),U),Y=IN_U_TRN
|
|---|
| 4 | SUFF F PRCNZZ=1:1:4 S STAT=$P("AF^AP^DF^DD",U,PRCNZZ),SUF=$E("ABCD",PRCNZZ) D SP
|
|---|
| 5 | S DA=IN,DIE="^PRCN(413,",DIK=DIE D ^DIK
|
|---|
| 6 | EXIT K DIC,DIE,DA,DR,STAT,SUF,X,PRCNZZ,DIK,ODA,STT,MSGN,NOD,NDA
|
|---|
| 7 | K PTRN,TRN
|
|---|
| 8 | Q
|
|---|
| 9 | ; Find if need to split a transaction and create new
|
|---|
| 10 | SP S (I,J)=0,(LIST("AF"),LIST("AP"),LIST("DF"),LIST("DD"))=""
|
|---|
| 11 | F S I=$O(^PRCN(413,IN,1,I)) Q:'+I S J=J+1,C=$P(^(I,0),U,8) D
|
|---|
| 12 | . S LIST(C)=$S(LIST(C)="":I,1:LIST(C)_U_I)
|
|---|
| 13 | S OLD=LIST("AF") S:PRCNZZ<2&(LIST("DF")]"") OLD=OLD_U_LIST("DF")
|
|---|
| 14 | S:PRCNZZ<4&(LIST("DD")]"") OLD=OLD_U_LIST("DD") S NEW=LIST(STAT)
|
|---|
| 15 | S STT=$S(STAT="AF":19,STAT="AP":18,STAT="DD":16,STAT="DF":17,1:"")
|
|---|
| 16 | S DA=IN D:NEW]"" NEW^PRCNSPL,STU S PTRN=TRN
|
|---|
| 17 | K DIE,DA,DR,C,I,J,LIST,OLD,NEW,APP,END,GL,GLO,GL2,IN2,J,J0
|
|---|
| 18 | K N,OTRN,PR,QTY,ST
|
|---|
| 19 | Q
|
|---|
| 20 | STU S (DIC,DIE)="^PRCN(413,",DA=NDA
|
|---|
| 21 | S DR="6////^S X=STT;7////^S X=DT;47///^S X=STAT;49///@"
|
|---|
| 22 | S MSGN=$S(STAT="AP":44,STAT="AF":43,STAT="DF":39,1:40)
|
|---|
| 23 | D ^DIE K NOD
|
|---|
| 24 | NEW IN S IN=NDA S:MSGN<43 NOD=38 D MES^PRCNMESG
|
|---|
| 25 | Q
|
|---|
