32 lines
1.4 KiB
Mathematica
32 lines
1.4 KiB
Mathematica
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
|