source: FOIAVistA/trunk/r/EQUIPMENT_TURN_IN_REQUEST-PRCN/PRCNTICM.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 1.4 KB
Line 
1PRCNTICM ;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
3EN 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
14EXT K DIC,DIE,DA,DR,IN,PRCNUSR,Y,PRCNCMR,PRCN,PRCNTDA,PRCNC,PRCNN,PRCNFAP
15 G EN
16MES ; 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
29EXIT K DIC,DIE,DA,DR,IN,PRCNUSR,Y,PRCNCMR,PRCN,PRCNTDA,PRCNC,PRCNN,PRCNFAP
30 K CMRZ,PRCNCM
31 Q
Note: See TracBrowser for help on using the repository browser.