| 1 | PRCNPPM ;SSI/ALA-PPM Equipment Request Process ;[ 08/07/96 2:58 PM ]
|
|---|
| 2 | ;;1.0;Equipment/Turn-In Request;**10**;Sep 13, 1996
|
|---|
| 3 | REV ; Review transaction
|
|---|
| 4 | S DIC("S")="I $P(^(0),U,7)=6!($P(^(0),U,7)=27)!($P(^(0),U,7)=32)"
|
|---|
| 5 | S DIC="^PRCN(413,",DIC(0)="AEQZ",DIE=413 D ^DIC G EXIT:+Y<0 K DIC("S")
|
|---|
| 6 | S (IN,DA)=+Y,STAT=$P(^PRCN(413,DA,0),U,7),STATS="6^^27^^^32^"
|
|---|
| 7 | D CMR
|
|---|
| 8 | F PRCNUSR=1:1:7 Q:STAT=$P(STATS,U,PRCNUSR)
|
|---|
| 9 | S DR=$S(STAT=6:"[PRCNPPM]",STAT=27:"[PRCNPPM1]",1:"[PRCNPPM2]")
|
|---|
| 10 | D SETUP^PRCNPRNT,^DIE
|
|---|
| 11 | I $G(STAT)=6,$P($G(^PRCN(413,DA,4)),U)="Y" W !!,"Transaction sent to Engineering for Review",!!
|
|---|
| 12 | I $G(STAT)=9 W !!,"Transaction sent to Selected Concurring Officials for Review",!!
|
|---|
| 13 | G REV
|
|---|
| 14 | EXIT K IN,DA,STAT,STATS,PRCNUSR,DR,DIC,DIE,PRCNC,PRCN,PRCNCMR,PRCNDATA
|
|---|
| 15 | K PRCNDAT4,PROG,FL,I,%,D,D0,SERV,LPRI,OLDPRI,PRIMAX,REQ,X,J
|
|---|
| 16 | Q
|
|---|
| 17 | CMR S PRCNC=$P(^PRCN(413,DA,0),U,16),PRCNCMR=""
|
|---|
| 18 | S PRCNCMR=$P(^ENG(6914.1,PRCNC,0),U,2)_U_$P($G(^(20)),U)
|
|---|
| 19 | Q
|
|---|
| 20 | MES ; Send mail message from PPM to requestor and CMR Official
|
|---|
| 21 | I $G(PRCNCMR)="" D CMR
|
|---|
| 22 | S XMB(1)=$P(^PRCN(413,D0,0),U),XMDUZ=DUZ
|
|---|
| 23 | I MSGN'=6 D
|
|---|
| 24 | . S REQ=$P(^PRCN(413,DA,0),U,2),XMY(REQ)=""
|
|---|
| 25 | . F II=1:1 S PRCNCMN=$P(PRCNCMR,U,II) Q:PRCNCMN="" D
|
|---|
| 26 | . . I PRCNCMN'="" S XMY(PRCNCMN)=""
|
|---|
| 27 | I MSGN=6 D
|
|---|
| 28 | . NEW Y
|
|---|
| 29 | . S Y=$P(^PRCN(413,D0,5,D1,0),U,5) X ^DD("DD") S XMB(2)=Y,XMB="PRCNCONC"
|
|---|
| 30 | . NEW DA S DA=D0 D CON^PRCNMESG
|
|---|
| 31 | . S KEY="PRCNPPM" D FND^PRCNMESG
|
|---|
| 32 | . S MSG(1)=""
|
|---|
| 33 | S XMB=$S(MSGN=1:"PRCNPPM1",1:$G(XMB))
|
|---|
| 34 | I $G(CFL)=0 Q
|
|---|
| 35 | I $G(NOD)="" G MS
|
|---|
| 36 | ; Append the explanation text to end of this mail message
|
|---|
| 37 | S NL=$P($G(^PRCN(413,DA,NOD,0)),U,3)
|
|---|
| 38 | I NL'="" F II=1:1:NL S MSG(II)=$G(^PRCN(413,DA,NOD,II,0))
|
|---|
| 39 | MS S XMTEXT="MSG(" D ^XMB
|
|---|
| 40 | K NL,MSGN,II,MSG,PRCNCMN,PRCNVA1,PRCNVA2,KEY,CFL,NOD,XMB,XMTEXT
|
|---|
| 41 | K PRCNCMR,PRCN,XMDUZ
|
|---|
| 42 | Q
|
|---|
| 43 | MESG ; Display message w/number of transactions for PPM stages
|
|---|
| 44 | W !,$C(7)
|
|---|
| 45 | D WOC^PRCNTIPP
|
|---|
| 46 | NEW ERROR S ERROR=""
|
|---|
| 47 | S PJ=0 F ST=6,7,10,13,19,27,32,33,37,39 D
|
|---|
| 48 | . S NI=0 F S NI=$O(^PRCN(413,"AC",ST,NI)) Q:'+NI S STA(ST)=$G(STA(ST))+1
|
|---|
| 49 | S NXI="" F S NXI=$O(STA(NXI)) Q:NXI="" D
|
|---|
| 50 | . S TEX3=$P(^PRCN(413.5,NXI,0),U),TEX1=$S(STA(NXI)=1:"is",1:"are")
|
|---|
| 51 | . S TEX2=$S(STA(NXI)=1:"request",1:"requests")
|
|---|
| 52 | . W !,?3,"There "_TEX1_" "_STA(NXI)_" equipment "_TEX2_" "_TEX3_"."
|
|---|
| 53 | K STA S PJ=0 F ST=6,23,25 D
|
|---|
| 54 | . S NI=0 F S NI=$O(^PRCN(413.1,NI)) Q:'+NI D
|
|---|
| 55 | . . ;
|
|---|
| 56 | . . I '$D(^PRCN(413.1,NI,0)) D QUIT ;FNC-1101-30237
|
|---|
| 57 | . . . QUIT:$D(ERROR(NI)) S ERROR(NI)=""
|
|---|
| 58 | . . . W !!,?3,"There is an invalid internal entry number in the "
|
|---|
| 59 | . . . W "TURN-IN REQUEST file."
|
|---|
| 60 | . . . W !,?3,"Please call NVS to review internal entry number ",NI
|
|---|
| 61 | . . . W " in file 413.1",!
|
|---|
| 62 | . . . ;
|
|---|
| 63 | . . I $P(^PRCN(413.1,NI,0),U,7)=ST S STA(ST)=$G(STA(ST))+1
|
|---|
| 64 | . . ;
|
|---|
| 65 | W ! S NXI="" F S NXI=$O(STA(NXI)) Q:NXI="" D
|
|---|
| 66 | . S TEX3=$P(^PRCN(413.5,NXI,0),U),TEX1=$S(STA(NXI)=1:"is",1:"are")
|
|---|
| 67 | . S TEX2=$S(STA(NXI)=1:"request",1:"requests")
|
|---|
| 68 | . W !,?3,"There "_TEX1_" "_STA(NXI)_" turn-in "_TEX2_" "_TEX3_"."
|
|---|
| 69 | K PJ,ST,NI,STA,NXI,TEX1,TEX2,TEX3
|
|---|
| 70 | Q
|
|---|
