PRCNPPM ;SSI/ALA-PPM Equipment Request Process ;[ 08/07/96 2:58 PM ]
;;1.0;Equipment/Turn-In Request;**10**;Sep 13, 1996
REV ; Review transaction
S DIC("S")="I $P(^(0),U,7)=6!($P(^(0),U,7)=27)!($P(^(0),U,7)=32)"
S DIC="^PRCN(413,",DIC(0)="AEQZ",DIE=413 D ^DIC G EXIT:+Y<0 K DIC("S")
S (IN,DA)=+Y,STAT=$P(^PRCN(413,DA,0),U,7),STATS="6^^27^^^32^"
D CMR
F PRCNUSR=1:1:7 Q:STAT=$P(STATS,U,PRCNUSR)
S DR=$S(STAT=6:"[PRCNPPM]",STAT=27:"[PRCNPPM1]",1:"[PRCNPPM2]")
D SETUP^PRCNPRNT,^DIE
I $G(STAT)=6,$P($G(^PRCN(413,DA,4)),U)="Y" W !!,"Transaction sent to Engineering for Review",!!
I $G(STAT)=9 W !!,"Transaction sent to Selected Concurring Officials for Review",!!
G REV
EXIT K IN,DA,STAT,STATS,PRCNUSR,DR,DIC,DIE,PRCNC,PRCN,PRCNCMR,PRCNDATA
K PRCNDAT4,PROG,FL,I,%,D,D0,SERV,LPRI,OLDPRI,PRIMAX,REQ,X,J
Q
CMR S PRCNC=$P(^PRCN(413,DA,0),U,16),PRCNCMR=""
S PRCNCMR=$P(^ENG(6914.1,PRCNC,0),U,2)_U_$P($G(^(20)),U)
Q
MES ; Send mail message from PPM to requestor and CMR Official
I $G(PRCNCMR)="" D CMR
S XMB(1)=$P(^PRCN(413,D0,0),U),XMDUZ=DUZ
I MSGN'=6 D
. S REQ=$P(^PRCN(413,DA,0),U,2),XMY(REQ)=""
. F II=1:1 S PRCNCMN=$P(PRCNCMR,U,II) Q:PRCNCMN="" D
. . I PRCNCMN'="" S XMY(PRCNCMN)=""
I MSGN=6 D
. NEW Y
. S Y=$P(^PRCN(413,D0,5,D1,0),U,5) X ^DD("DD") S XMB(2)=Y,XMB="PRCNCONC"
. NEW DA S DA=D0 D CON^PRCNMESG
. S KEY="PRCNPPM" D FND^PRCNMESG
. S MSG(1)=""
S XMB=$S(MSGN=1:"PRCNPPM1",1:$G(XMB))
I $G(CFL)=0 Q
I $G(NOD)="" G MS
; Append the explanation text to end of this mail message
S NL=$P($G(^PRCN(413,DA,NOD,0)),U,3)
I NL'="" F II=1:1:NL S MSG(II)=$G(^PRCN(413,DA,NOD,II,0))
MS S XMTEXT="MSG(" D ^XMB
K NL,MSGN,II,MSG,PRCNCMN,PRCNVA1,PRCNVA2,KEY,CFL,NOD,XMB,XMTEXT
K PRCNCMR,PRCN,XMDUZ
Q
MESG ; Display message w/number of transactions for PPM stages
W !,$C(7)
D WOC^PRCNTIPP
NEW ERROR S ERROR=""
S PJ=0 F ST=6,7,10,13,19,27,32,33,37,39 D
. S NI=0 F S NI=$O(^PRCN(413,"AC",ST,NI)) Q:'+NI S STA(ST)=$G(STA(ST))+1
S NXI="" F S NXI=$O(STA(NXI)) Q:NXI="" D
. S TEX3=$P(^PRCN(413.5,NXI,0),U),TEX1=$S(STA(NXI)=1:"is",1:"are")
. S TEX2=$S(STA(NXI)=1:"request",1:"requests")
. W !,?3,"There "_TEX1_" "_STA(NXI)_" equipment "_TEX2_" "_TEX3_"."
K STA S PJ=0 F ST=6,23,25 D
. S NI=0 F S NI=$O(^PRCN(413.1,NI)) Q:'+NI D
. . ;
. . I '$D(^PRCN(413.1,NI,0)) D QUIT ;FNC-1101-30237
. . . QUIT:$D(ERROR(NI)) S ERROR(NI)=""
. . . W !!,?3,"There is an invalid internal entry number in the "
. . . W "TURN-IN REQUEST file."
. . . W !,?3,"Please call NVS to review internal entry number ",NI
. . . W " in file 413.1",!
. . . ;
. . I $P(^PRCN(413.1,NI,0),U,7)=ST S STA(ST)=$G(STA(ST))+1
. . ;
W ! S NXI="" F S NXI=$O(STA(NXI)) Q:NXI="" D
. S TEX3=$P(^PRCN(413.5,NXI,0),U),TEX1=$S(STA(NXI)=1:"is",1:"are")
. S TEX2=$S(STA(NXI)=1:"request",1:"requests")
. W !,?3,"There "_TEX1_" "_STA(NXI)_" turn-in "_TEX2_" "_TEX3_"."
K PJ,ST,NI,STA,NXI,TEX1,TEX2,TEX3
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCNPPM 2978 printed Oct 16, 2024@17:55:16 Page 2
PRCNPPM ;SSI/ALA-PPM Equipment Request Process ;[ 08/07/96 2:58 PM ]
+1 ;;1.0;Equipment/Turn-In Request;**10**;Sep 13, 1996
REV ; Review transaction
+1 SET DIC("S")="I $P(^(0),U,7)=6!($P(^(0),U,7)=27)!($P(^(0),U,7)=32)"
+2 SET DIC="^PRCN(413,"
SET DIC(0)="AEQZ"
SET DIE=413
DO ^DIC
if +Y<0
GOTO EXIT
KILL DIC("S")
+3 SET (IN,DA)=+Y
SET STAT=$PIECE(^PRCN(413,DA,0),U,7)
SET STATS="6^^27^^^32^"
+4 DO CMR
+5 FOR PRCNUSR=1:1:7
if STAT=$PIECE(STATS,U,PRCNUSR)
QUIT
+6 SET DR=$SELECT(STAT=6:"[PRCNPPM]",STAT=27:"[PRCNPPM1]",1:"[PRCNPPM2]")
+7 DO SETUP^PRCNPRNT
DO ^DIE
+8 IF $GET(STAT)=6
IF $PIECE($GET(^PRCN(413,DA,4)),U)="Y"
WRITE !!,"Transaction sent to Engineering for Review",!!
+9 IF $GET(STAT)=9
WRITE !!,"Transaction sent to Selected Concurring Officials for Review",!!
+10 GOTO REV
EXIT KILL IN,DA,STAT,STATS,PRCNUSR,DR,DIC,DIE,PRCNC,PRCN,PRCNCMR,PRCNDATA
+1 KILL PRCNDAT4,PROG,FL,I,%,D,D0,SERV,LPRI,OLDPRI,PRIMAX,REQ,X,J
+2 QUIT
CMR SET PRCNC=$PIECE(^PRCN(413,DA,0),U,16)
SET PRCNCMR=""
+1 SET PRCNCMR=$PIECE(^ENG(6914.1,PRCNC,0),U,2)_U_$PIECE($GET(^(20)),U)
+2 QUIT
MES ; Send mail message from PPM to requestor and CMR Official
+1 IF $GET(PRCNCMR)=""
DO CMR
+2 SET XMB(1)=$PIECE(^PRCN(413,D0,0),U)
SET XMDUZ=DUZ
+3 IF MSGN'=6
Begin DoDot:1
+4 SET REQ=$PIECE(^PRCN(413,DA,0),U,2)
SET XMY(REQ)=""
+5 FOR II=1:1
SET PRCNCMN=$PIECE(PRCNCMR,U,II)
if PRCNCMN=""
QUIT
Begin DoDot:2
+6 IF PRCNCMN'=""
SET XMY(PRCNCMN)=""
End DoDot:2
End DoDot:1
+7 IF MSGN=6
Begin DoDot:1
+8 NEW Y
+9 SET Y=$PIECE(^PRCN(413,D0,5,D1,0),U,5)
XECUTE ^DD("DD")
SET XMB(2)=Y
SET XMB="PRCNCONC"
+10 NEW DA
SET DA=D0
DO CON^PRCNMESG
+11 SET KEY="PRCNPPM"
DO FND^PRCNMESG
+12 SET MSG(1)=""
End DoDot:1
+13 SET XMB=$SELECT(MSGN=1:"PRCNPPM1",1:$GET(XMB))
+14 IF $GET(CFL)=0
QUIT
+15 IF $GET(NOD)=""
GOTO MS
+16 ; Append the explanation text to end of this mail message
+17 SET NL=$PIECE($GET(^PRCN(413,DA,NOD,0)),U,3)
+18 IF NL'=""
FOR II=1:1:NL
SET MSG(II)=$GET(^PRCN(413,DA,NOD,II,0))
MS SET XMTEXT="MSG("
DO ^XMB
+1 KILL NL,MSGN,II,MSG,PRCNCMN,PRCNVA1,PRCNVA2,KEY,CFL,NOD,XMB,XMTEXT
+2 KILL PRCNCMR,PRCN,XMDUZ
+3 QUIT
MESG ; Display message w/number of transactions for PPM stages
+1 WRITE !,$CHAR(7)
+2 DO WOC^PRCNTIPP
+3 NEW ERROR
SET ERROR=""
+4 SET PJ=0
FOR ST=6,7,10,13,19,27,32,33,37,39
Begin DoDot:1
+5 SET NI=0
FOR
SET NI=$ORDER(^PRCN(413,"AC",ST,NI))
if '+NI
QUIT
SET STA(ST)=$GET(STA(ST))+1
End DoDot:1
+6 SET NXI=""
FOR
SET NXI=$ORDER(STA(NXI))
if NXI=""
QUIT
Begin DoDot:1
+7 SET TEX3=$PIECE(^PRCN(413.5,NXI,0),U)
SET TEX1=$SELECT(STA(NXI)=1:"is",1:"are")
+8 SET TEX2=$SELECT(STA(NXI)=1:"request",1:"requests")
+9 WRITE !,?3,"There "_TEX1_" "_STA(NXI)_" equipment "_TEX2_" "_TEX3_"."
End DoDot:1
+10 KILL STA
SET PJ=0
FOR ST=6,23,25
Begin DoDot:1
+11 SET NI=0
FOR
SET NI=$ORDER(^PRCN(413.1,NI))
if '+NI
QUIT
Begin DoDot:2
+12 ;
+13 ;FNC-1101-30237
IF '$DATA(^PRCN(413.1,NI,0))
Begin DoDot:3
+14 if $DATA(ERROR(NI))
QUIT
SET ERROR(NI)=""
+15 WRITE !!,?3,"There is an invalid internal entry number in the "
+16 WRITE "TURN-IN REQUEST file."
+17 WRITE !,?3,"Please call NVS to review internal entry number ",NI
+18 WRITE " in file 413.1",!
+19 ;
End DoDot:3
QUIT
+20 IF $PIECE(^PRCN(413.1,NI,0),U,7)=ST
SET STA(ST)=$GET(STA(ST))+1
+21 ;
End DoDot:2
End DoDot:1
+22 WRITE !
SET NXI=""
FOR
SET NXI=$ORDER(STA(NXI))
if NXI=""
QUIT
Begin DoDot:1
+23 SET TEX3=$PIECE(^PRCN(413.5,NXI,0),U)
SET TEX1=$SELECT(STA(NXI)=1:"is",1:"are")
+24 SET TEX2=$SELECT(STA(NXI)=1:"request",1:"requests")
+25 WRITE !,?3,"There "_TEX1_" "_STA(NXI)_" turn-in "_TEX2_" "_TEX3_"."
End DoDot:1
+26 KILL PJ,ST,NI,STA,NXI,TEX1,TEX2,TEX3
+27 QUIT
