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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCNTICM 1424 printed Nov 22, 2024@17:04:51 Page 2
PRCNTICM ;SSI/SEB-CMR Official Review/Approval for Turnin ;[ 03/13/97 10:28 AM ]
+1 ;;1.0;PRCN;**2,3,14,15**;Sep 13, 1996
EN SET PRCNC=DUZ
DO CMR^PRCNCMR
KILL PRCNC
+1 SET DIC("S")="S ST=$P(^(0),U,7),CMRZ=$P(^(0),U,16) I ST=3&($D(PRCNCMR(CMRZ)))"
+2 SET DIC="^PRCN(413.1,"
SET DIC(0)="AEQZ"
DO ^DIC
if +Y<0
GOTO EXIT
KILL DIC("S")
+3 SET (DA,PRCNTDA,IN)=+Y
SET PRCNUSR=0
DO SETUP^PRCNTIPR
+4 SET DIE=413.1
SET DR="[PRCNTICMR]"
DO ^DIE
+5 ; PRCN*1.0*15
IF $DATA(^PRCN(413.1,DA,2))
SET GLO=413.1
DO MES
+6 ; Set the turn-in date in 6914
+7 SET PRCNN=0
FOR
SET PRCNN=$ORDER(^PRCN(413.1,PRCNTDA,1,PRCNN))
if 'PRCNN
QUIT
Begin DoDot:1
+8 SET DA=$PIECE(^PRCN(413.1,PRCNTDA,1,PRCNN,0),U)
+9 SET PRCNFAP=$$CHKFA^ENFAUTL(DA)
if $PIECE(PRCNFAP,U)=1
QUIT
+10 SET (DIE,DIC)=6914
SET DR="20.5////^S X=DT"
DO ^DIE
End DoDot:1
EXT KILL DIC,DIE,DA,DR,IN,PRCNUSR,Y,PRCNCMR,PRCN,PRCNTDA,PRCNC,PRCNN,PRCNFAP
+1 GOTO EN
MES ; Send mail message when CMR Official has not approved request
+1 NEW GLO
+2 SET GLO=413.1
+3 SET XMB(1)=$PIECE(^PRCN(413.1,DA,0),U)
SET XMDUZ=DUZ
+4 SET XMB="PRCNCMR2"
SET XMY($PIECE(^PRCN(413.1,DA,0),U,2))=""
SET XMY(XMDUZ)=""
+5 SET CMRDA=$PIECE(^PRCN(413.1,DA,0),U,16)
+6 IF CMRDA'=""
IF $DATA(^ENG(6914.1,CMRDA,0))
IF ($PIECE(^ENG(6914.1,CMRDA,0),U,2)'="")
SET XMY($PIECE(^ENG(6914.1,CMRDA,0),U,2))=""
+7 ; Append the explanation text
+8 SET NL=$PIECE($GET(^PRCN(413.1,DA,2,0)),U,3)
SET XMTEXT="MSG("
+9 IF NL'=""
FOR I=1:1:NL
SET MSG(I)=$GET(^PRCN(413.1,DA,2,I,0))
+10 DO ^XMB
+11 KILL MSG,NL,XMB,XMTEXT,I,XMY,XMDUZ
+12 QUIT
EXIT KILL DIC,DIE,DA,DR,IN,PRCNUSR,Y,PRCNCMR,PRCN,PRCNTDA,PRCNC,PRCNN,PRCNFAP
+1 KILL CMRZ,PRCNCM
+2 QUIT
