| [613] | 1 | PRCNTICM ;SSI/SEB-CMR Official Review/Approval for Turnin ;[ 03/13/97 10:28 AM ]
|
|---|
| 2 | ;;1.0;PRCN;**2,3,14,15**;Sep 13, 1996
|
|---|
| 3 | EN S PRCNC=DUZ D CMR^PRCNCMR K PRCNC
|
|---|
| 4 | S DIC("S")="S ST=$P(^(0),U,7),CMRZ=$P(^(0),U,16) I ST=3&($D(PRCNCMR(CMRZ)))"
|
|---|
| 5 | S DIC="^PRCN(413.1,",DIC(0)="AEQZ" D ^DIC G EXIT:+Y<0 K DIC("S")
|
|---|
| 6 | S (DA,PRCNTDA,IN)=+Y,PRCNUSR=0 D SETUP^PRCNTIPR
|
|---|
| 7 | S DIE=413.1,DR="[PRCNTICMR]" D ^DIE
|
|---|
| 8 | I $D(^PRCN(413.1,DA,2)) S GLO=413.1 D MES ; PRCN*1.0*15
|
|---|
| 9 | ; Set the turn-in date in 6914
|
|---|
| 10 | S PRCNN=0 F S PRCNN=$O(^PRCN(413.1,PRCNTDA,1,PRCNN)) Q:'PRCNN D
|
|---|
| 11 | . S DA=$P(^PRCN(413.1,PRCNTDA,1,PRCNN,0),U)
|
|---|
| 12 | . S PRCNFAP=$$CHKFA^ENFAUTL(DA) Q:$P(PRCNFAP,U)=1
|
|---|
| 13 | . S (DIE,DIC)=6914,DR="20.5////^S X=DT" D ^DIE
|
|---|
| 14 | EXT K DIC,DIE,DA,DR,IN,PRCNUSR,Y,PRCNCMR,PRCN,PRCNTDA,PRCNC,PRCNN,PRCNFAP
|
|---|
| 15 | G EN
|
|---|
| 16 | MES ; Send mail message when CMR Official has not approved request
|
|---|
| 17 | N GLO
|
|---|
| 18 | S GLO=413.1
|
|---|
| 19 | S XMB(1)=$P(^PRCN(413.1,DA,0),U),XMDUZ=DUZ
|
|---|
| 20 | S XMB="PRCNCMR2",XMY($P(^PRCN(413.1,DA,0),U,2))="",XMY(XMDUZ)=""
|
|---|
| 21 | S CMRDA=$P(^PRCN(413.1,DA,0),U,16)
|
|---|
| 22 | I CMRDA'="",$D(^ENG(6914.1,CMRDA,0)),($P(^ENG(6914.1,CMRDA,0),U,2)'="") S XMY($P(^ENG(6914.1,CMRDA,0),U,2))=""
|
|---|
| 23 | ; Append the explanation text
|
|---|
| 24 | S NL=$P($G(^PRCN(413.1,DA,2,0)),U,3),XMTEXT="MSG("
|
|---|
| 25 | I NL'="" F I=1:1:NL S MSG(I)=$G(^PRCN(413.1,DA,2,I,0))
|
|---|
| 26 | D ^XMB
|
|---|
| 27 | K MSG,NL,XMB,XMTEXT,I,XMY,XMDUZ
|
|---|
| 28 | Q
|
|---|
| 29 | EXIT K DIC,DIE,DA,DR,IN,PRCNUSR,Y,PRCNCMR,PRCN,PRCNTDA,PRCNC,PRCNN,PRCNFAP
|
|---|
| 30 | K CMRZ,PRCNCM
|
|---|
| 31 | Q
|
|---|
