- PRCNREQE ;SSI/ALA,SEB-Edit a NX Request ;[ 02/06/97 11:55 AM ]
- ;;1.0;Equipment/Turn-In Request;**3,11,12,14**;Sep 13, 1996
- EN S DIC="^PRCN(413,",DIC(0)="AEQZ"
- I $G(PRCNCMF)="" S DIC("S")="S ST=$P(^(0),U,7) I ST=1!(ST=3)!(ST=4)!(ST=11)!(ST=12)!(ST=15)&($P(^(0),U,2)=DUZ)"
- I $G(PRCNCMF)'="" D
- . S PRCNC=DUZ D CMR^PRCNCMR K PRCNC
- . S DIC("S")="S ST=$P(^(0),U,7),CMRZ=$P(^(0),U,16) I ST=1!(ST=3)!(ST=5)!(ST=4)!(ST=11)!(ST=45)!(ST=17)!(ST=18)!(ST=15)&($D(PRCNCMR(CMRZ)))"
- D ^DIC K DIC("S") G EQ:Y<0 S IN=+Y,PRCNUSR=0 D SETUP^PRCNPRNT
- I $P($G(^PRCN(413,IN,2)),U,16)]"" S $P(^(2),U,16)="" K ^PRCN(413,IN,15)
- EDIT ; Edit the transaction if desired
- W !,"Do you want to edit this request" S %=2 D YN^DICN G EDIT:%=0
- G EQ:%'=1
- K NEW S DIE=413,DIE("NO^")="OUTOK",DR="[PRCNEDIT]",DA=IN D ^DIE
- I PRCNTY="R" D
- . I $G(TDA)="" S TDA=$P(^PRCN(413,DA,0),U,11)
- . I $G(PRCNTDA)="" S PRCNTDA=TDA
- . Q:$O(^PRCN(413.1,PRCNTDA,1,0))=""
- . S EDIT=2,DIE=413.1,DR="[PRCNTIRQ]",DA=PRCNTDA D ^DIE
- EQ K DIC,DIE,DA,DR,IN,PRCNUSR,PRCNQT,PRCNTXT,PRCNTY,PRCNCMR,CMRZ,ST,STA
- K J,JJ,PRCN,PRCNC,VEN,PRCNTDA,D1,PFL,QTY,RDA,RDI,TDA,EDIT
- Q
- LINE ; Display associated replacement line items
- S RDA=D0,RDI=D1,QTY=$P($G(^PRCN(413,RDA,1,RDI,0)),U,5)
- EN1 N DIEL,DG,DI,DK,DL,DM,DP,DU,D0,D1,DA,DIC,DIE,DR,DQ,X,Y,DV,DOV
- S DIC("S")="I $P(^(0),U,3)=RDI",DA(1)=TDA,DIC(0)="AEQZ",DIC("A")="Select Replacement Line Item: "
- S PRCNCMR=$P(^PRCN(413.1,TDA,0),U,16)
- S DIC="^PRCN(413.1,"_TDA_",1," D ^DIC Q:Y<1 S RI=$P(Y,U,2),DA=+Y D DISP^PRCNTIRQ K DIC("S")
- S DIE("NO^")=""
- S DR=".01;.5Replacement Justification~;I X'=6 S Y="""";.7",DIE=DIC D ^DIE
- D CT I NUM<QTY D
- . W !,"Number of replacement items does not equal quantity"
- . S NM=$P($G(^PRCN(413.1,TDA,1,0)),U,3)
- . I NM="" S ^PRCN(413.1,TDA,1,0)="^413.11IPA^^"
- . D RP2^PRCNREQN
- EXIT K TDA,RDA,RI,DA,DIE,DIC,DR
- Q
- CT S NUM=0,NN="" F S NN=$O(^PRCN(413.1,TDA,1,"AC",RDI,NN)) Q:NN="" S NUM=NUM+1
- Q
- TXT ; Set first 20 characters into Short Description field
- S $P(^PRCN(413,D0,0),U,18)=""
- S PRCNTXT=$G(^PRCN(413,D0,1,1,1,1,0))
- I $L(PRCNTXT)>20 S PRCNTXT=$E(PRCNTXT,1,20)
- S VEN=$P($G(^PRCN(413,D0,1,D1,0)),U,2) S:VEN'="" VEN=$P(^PRC(440,VEN,0),U)
- S VEN=$S($G(VEN)="":$P($G(^PRCN(413,D0,1,D1,0)),U,13),1:VEN)
- Q
- CMP ; Check for completeness of data
- S PFL=0
- S PDD1=D1 D CMPD Q:QFL
- S PDD1=0 F S PDD1=$O(^PRCN(413,D0,1,PDD1)) Q:'PDD1 D CMPD Q:QFL
- I $P(^PRCN(413,D0,0),U,9)'="R" S PFL=1
- Q
- CMPD S QFL=0
- Q:'$D(^PRCN(413,D0,1,PDD1))
- F I=1,4,5,12 I $P(^PRCN(413,D0,1,PDD1,0),U,I)="" S QFL=1 Q
- I $P(^PRCN(413,D0,1,PDD1,0),U,12)="P" S PFL=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCNREQE 2622 printed Jan 18, 2025@02:55:45 Page 2
- PRCNREQE ;SSI/ALA,SEB-Edit a NX Request ;[ 02/06/97 11:55 AM ]
- +1 ;;1.0;Equipment/Turn-In Request;**3,11,12,14**;Sep 13, 1996
- EN SET DIC="^PRCN(413,"
- SET DIC(0)="AEQZ"
- +1 IF $GET(PRCNCMF)=""
- SET DIC("S")="S ST=$P(^(0),U,7) I ST=1!(ST=3)!(ST=4)!(ST=11)!(ST=12)!(ST=15)&($P(^(0),U,2)=DUZ)"
- +2 IF $GET(PRCNCMF)'=""
- Begin DoDot:1
- +3 SET PRCNC=DUZ
- DO CMR^PRCNCMR
- KILL PRCNC
- +4 SET DIC("S")="S ST=$P(^(0),U,7),CMRZ=$P(^(0),U,16) I ST=1!(ST=3)!(ST=5)!(ST=4)!(ST=11)!(ST=45)!(ST=17)!(ST=18)!(ST=15)&($D(PRCNCMR(CMRZ)))"
- End DoDot:1
- +5 DO ^DIC
- KILL DIC("S")
- if Y<0
- GOTO EQ
- SET IN=+Y
- SET PRCNUSR=0
- DO SETUP^PRCNPRNT
- +6 IF $PIECE($GET(^PRCN(413,IN,2)),U,16)]""
- SET $PIECE(^(2),U,16)=""
- KILL ^PRCN(413,IN,15)
- EDIT ; Edit the transaction if desired
- +1 WRITE !,"Do you want to edit this request"
- SET %=2
- DO YN^DICN
- if %=0
- GOTO EDIT
- +2 if %'=1
- GOTO EQ
- +3 KILL NEW
- SET DIE=413
- SET DIE("NO^")="OUTOK"
- SET DR="[PRCNEDIT]"
- SET DA=IN
- DO ^DIE
- +4 IF PRCNTY="R"
- Begin DoDot:1
- +5 IF $GET(TDA)=""
- SET TDA=$PIECE(^PRCN(413,DA,0),U,11)
- +6 IF $GET(PRCNTDA)=""
- SET PRCNTDA=TDA
- +7 if $ORDER(^PRCN(413.1,PRCNTDA,1,0))=""
- QUIT
- +8 SET EDIT=2
- SET DIE=413.1
- SET DR="[PRCNTIRQ]"
- SET DA=PRCNTDA
- DO ^DIE
- End DoDot:1
- EQ KILL DIC,DIE,DA,DR,IN,PRCNUSR,PRCNQT,PRCNTXT,PRCNTY,PRCNCMR,CMRZ,ST,STA
- +1 KILL J,JJ,PRCN,PRCNC,VEN,PRCNTDA,D1,PFL,QTY,RDA,RDI,TDA,EDIT
- +2 QUIT
- LINE ; Display associated replacement line items
- +1 SET RDA=D0
- SET RDI=D1
- SET QTY=$PIECE($GET(^PRCN(413,RDA,1,RDI,0)),U,5)
- EN1 NEW DIEL,DG,DI,DK,DL,DM,DP,DU,D0,D1,DA,DIC,DIE,DR,DQ,X,Y,DV,DOV
- +1 SET DIC("S")="I $P(^(0),U,3)=RDI"
- SET DA(1)=TDA
- SET DIC(0)="AEQZ"
- SET DIC("A")="Select Replacement Line Item: "
- +2 SET PRCNCMR=$PIECE(^PRCN(413.1,TDA,0),U,16)
- +3 SET DIC="^PRCN(413.1,"_TDA_",1,"
- DO ^DIC
- if Y<1
- QUIT
- SET RI=$PIECE(Y,U,2)
- SET DA=+Y
- DO DISP^PRCNTIRQ
- KILL DIC("S")
- +4 SET DIE("NO^")=""
- +5 SET DR=".01;.5Replacement Justification~;I X'=6 S Y="""";.7"
- SET DIE=DIC
- DO ^DIE
- +6 DO CT
- IF NUM<QTY
- Begin DoDot:1
- +7 WRITE !,"Number of replacement items does not equal quantity"
- +8 SET NM=$PIECE($GET(^PRCN(413.1,TDA,1,0)),U,3)
- +9 IF NM=""
- SET ^PRCN(413.1,TDA,1,0)="^413.11IPA^^"
- +10 DO RP2^PRCNREQN
- End DoDot:1
- EXIT KILL TDA,RDA,RI,DA,DIE,DIC,DR
- +1 QUIT
- CT SET NUM=0
- SET NN=""
- FOR
- SET NN=$ORDER(^PRCN(413.1,TDA,1,"AC",RDI,NN))
- if NN=""
- QUIT
- SET NUM=NUM+1
- +1 QUIT
- TXT ; Set first 20 characters into Short Description field
- +1 SET $PIECE(^PRCN(413,D0,0),U,18)=""
- +2 SET PRCNTXT=$GET(^PRCN(413,D0,1,1,1,1,0))
- +3 IF $LENGTH(PRCNTXT)>20
- SET PRCNTXT=$EXTRACT(PRCNTXT,1,20)
- +4 SET VEN=$PIECE($GET(^PRCN(413,D0,1,D1,0)),U,2)
- if VEN'=""
- SET VEN=$PIECE(^PRC(440,VEN,0),U)
- +5 SET VEN=$SELECT($GET(VEN)="":$PIECE($GET(^PRCN(413,D0,1,D1,0)),U,13),1:VEN)
- +6 QUIT
- CMP ; Check for completeness of data
- +1 SET PFL=0
- +2 SET PDD1=D1
- DO CMPD
- if QFL
- QUIT
- +3 SET PDD1=0
- FOR
- SET PDD1=$ORDER(^PRCN(413,D0,1,PDD1))
- if 'PDD1
- QUIT
- DO CMPD
- if QFL
- QUIT
- +4 IF $PIECE(^PRCN(413,D0,0),U,9)'="R"
- SET PFL=1
- +5 QUIT
- CMPD SET QFL=0
- +1 if '$DATA(^PRCN(413,D0,1,PDD1))
- QUIT
- +2 FOR I=1,4,5,12
- IF $PIECE(^PRCN(413,D0,1,PDD1,0),U,I)=""
- SET QFL=1
- QUIT
- +3 IF $PIECE(^PRCN(413,D0,1,PDD1,0),U,12)="P"
- SET PFL=1
- +4 QUIT