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