- PRCNTIPP ;SSI/SEB,ALA-PPM Turn-in review ;[ 05/31/96 10:34 AM ]
- ;;1.0;Equipment/Turn-In Request;**15**;Sep 13, 1996
- SELECT ; Select a Turn-in request
- N PRCNFLAG S PRCNFLAG=0 ; PRCN*1.0*15
- D WOC,FAC^PRCNFAP,FDC^PRCNFAP S PRCNFLAG=PRCNFLAG+1
- S DIC(0)="AEQZ",DIC="^PRCN(413.1,"
- I PRCNUSR=2 S DIC("S")="I $P(^(0),U,7)=23"
- I PRCNUSR=1 S DIC("S")="I $P(^(0),U,7)=6!($P(^(0),U,7)=25)"
- D ^DIC K DIC("S") G EXIT:+Y<0
- PR S (IN,PRCNTDA,DA)=+Y,TIF=1 D SETUP^PRCNTIPR
- K F,FF,FN,ID,PRCNDD,PRCNDEEP,PV,TIF
- I PRCNUSR=2 D G SELECT
- . S TDA=PRCNTDA,STAT=44,CKA=1 D CK^PRCNFAP I SFL D SQ Q
- . S DR="[PRCNTIPPM]",DIE=413.1 W ! D ^DIE
- . D:'POP RESET^PRCNUTL ; PRCN*1.0*15
- . D SQ
- . K POP ; PRCN*1.0*15
- S TDA=DA,TI=0,STAT=$P(^PRCN(413.1,TDA,0),U,7),WOFL=0
- I STAT=25 D WH,SQ G SELECT
- F S TI=$O(^PRCN(413.1,TDA,1,TI)) Q:TI'>0 D Q:$D(DUOUT)
- . S WOFL=0 D ITEM Q:$D(DUOUT)
- . I 'WOFL D WH Q
- . I WOFL S DA=TDA,(DIC,DIE)=413.1,DR="6////^S X=21;7////^S X=DT" D ^DIE,SQ Q
- D SQ
- G SELECT
- WH W !,"Is this request ready to go to Warehouse for pickup"
- QH S %=1 D YN^DICN
- I %=0 D G QH
- . W !!,"Enter 'Yes' to send the turn-in request to Warehouse user."
- I %=1 S DA=TDA,DIE=413.1,DR="6////^S X=22;7////^S X=DT" D ^DIE
- SQ K DIC,DIE,DR,DA,DUOUT,IN,Y,C,%,WOFL,SFL
- Q
- ITEM ; Display and process line items
- S NL=0 D TURNIN^PRCNPRNT
- S WODATA=IN_U_$P($G(^ENG(6914,IN,3)),U,5)
- COND ; Get the condition code
- S DA(1)=TDA,DA=TI,DIC="^PRCN(413.1,"_DA(1)_",1,"
- S DIE=DIC,DR=1 D ^DIE
- WO K % I $G(^DIC(6910,1,0))="" S %=2
- W !!,"Should a work order be generated for this line item" D YN^DICN
- I %=-1,%Y="^" S DUOUT="^" Q
- I %=0 D G WO
- . W !!,"Please enter 'Y'es if Engineering must disconnect or otherwise support the turn-in of this equipment."
- S C=$S(%=1:"Y",1:"N"),$P(^PRCN(413.1,TDA,1,TI,0),U,4)=C
- I C'="Y" Q
- S PRCNSRV=$P(^PRCN(413.1,TDA,0),U,3)
- D TRNIN^ENWONEW2
- I $G(ENDA)="" W !,"Not able to create work order at this time!" G WO
- S DA(1)=TDA,DA=TI,DIC="^PRCN(413.1,"_DA(1)_",1,",DIE=DIC,WOFL=1
- S DR="11////^S X=ENDA" D ^DIE
- IQ K NL,WODATA,C,CODES,II,S,PRCNFL,ENDR,ENLO,ENHI,PRCNSRV,ENDA,ENWO
- Q
- WOC ; Work order completion
- S TDA="" F S TDA=$O(^PRCN(413.1,"AC",21,TDA)) Q:TDA="" D CS
- K TDA Q
- CS ; Check if all work orders have been completed
- S N=0 F S N=$O(^PRCN(413.1,TDA,1,N)) Q:N'>0 D
- . S WODA=$P(^PRCN(413.1,TDA,1,N,0),U,14) Q:WODA=""
- . I $P($G(^ENG(6920,WODA,5)),U,2)'="" S DA=TDA,DIE=413.1,DR="6////^S X=25;7////^S X=DT" D ^DIE
- K DA,DIE,DR,N,WODA
- Q
- PRT ; Print turnin item
- NEW X,Y,N,F,I
- S TDA=D0,TI=D1,NL=0 D TURNIN^PRCNPRNT
- K F,FF,FN,GLO,I,IN,J,N,N2,NEWL,NL,OGLO,OID,OIN,OPC,PC,PGLO,PRCNDD
- K PRCNDEEP,PGL,PV,TDA,TI,VAL,CODES
- Q
- EXIT K PRCNTDA,DIC,DIE,DR,DA,DUOUT,IN,Y,C,%,WOFL,SFL,D0,D1,D,TDA,CODE,CODES
- K CP,DIR,PGL,OIN,PC,PRCNCT,L,OGLO,OID,OPC
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCNTIPP 2839 printed Jan 18, 2025@02:55:56 Page 2
- PRCNTIPP ;SSI/SEB,ALA-PPM Turn-in review ;[ 05/31/96 10:34 AM ]
- +1 ;;1.0;Equipment/Turn-In Request;**15**;Sep 13, 1996
- SELECT ; Select a Turn-in request
- +1 ; PRCN*1.0*15
- NEW PRCNFLAG
- SET PRCNFLAG=0
- +2 DO WOC
- DO FAC^PRCNFAP
- DO FDC^PRCNFAP
- SET PRCNFLAG=PRCNFLAG+1
- +3 SET DIC(0)="AEQZ"
- SET DIC="^PRCN(413.1,"
- +4 IF PRCNUSR=2
- SET DIC("S")="I $P(^(0),U,7)=23"
- +5 IF PRCNUSR=1
- SET DIC("S")="I $P(^(0),U,7)=6!($P(^(0),U,7)=25)"
- +6 DO ^DIC
- KILL DIC("S")
- if +Y<0
- GOTO EXIT
- PR SET (IN,PRCNTDA,DA)=+Y
- SET TIF=1
- DO SETUP^PRCNTIPR
- +1 KILL F,FF,FN,ID,PRCNDD,PRCNDEEP,PV,TIF
- +2 IF PRCNUSR=2
- Begin DoDot:1
- +3 SET TDA=PRCNTDA
- SET STAT=44
- SET CKA=1
- DO CK^PRCNFAP
- IF SFL
- DO SQ
- QUIT
- +4 SET DR="[PRCNTIPPM]"
- SET DIE=413.1
- WRITE !
- DO ^DIE
- +5 ; PRCN*1.0*15
- if 'POP
- DO RESET^PRCNUTL
- +6 DO SQ
- +7 ; PRCN*1.0*15
- KILL POP
- End DoDot:1
- GOTO SELECT
- +8 SET TDA=DA
- SET TI=0
- SET STAT=$PIECE(^PRCN(413.1,TDA,0),U,7)
- SET WOFL=0
- +9 IF STAT=25
- DO WH
- DO SQ
- GOTO SELECT
- +10 FOR
- SET TI=$ORDER(^PRCN(413.1,TDA,1,TI))
- if TI'>0
- QUIT
- Begin DoDot:1
- +11 SET WOFL=0
- DO ITEM
- if $DATA(DUOUT)
- QUIT
- +12 IF 'WOFL
- DO WH
- QUIT
- +13 IF WOFL
- SET DA=TDA
- SET (DIC,DIE)=413.1
- SET DR="6////^S X=21;7////^S X=DT"
- DO ^DIE
- DO SQ
- QUIT
- End DoDot:1
- if $DATA(DUOUT)
- QUIT
- +14 DO SQ
- +15 GOTO SELECT
- WH WRITE !,"Is this request ready to go to Warehouse for pickup"
- QH SET %=1
- DO YN^DICN
- +1 IF %=0
- Begin DoDot:1
- +2 WRITE !!,"Enter 'Yes' to send the turn-in request to Warehouse user."
- End DoDot:1
- GOTO QH
- +3 IF %=1
- SET DA=TDA
- SET DIE=413.1
- SET DR="6////^S X=22;7////^S X=DT"
- DO ^DIE
- SQ KILL DIC,DIE,DR,DA,DUOUT,IN,Y,C,%,WOFL,SFL
- +1 QUIT
- ITEM ; Display and process line items
- +1 SET NL=0
- DO TURNIN^PRCNPRNT
- +2 SET WODATA=IN_U_$PIECE($GET(^ENG(6914,IN,3)),U,5)
- COND ; Get the condition code
- +1 SET DA(1)=TDA
- SET DA=TI
- SET DIC="^PRCN(413.1,"_DA(1)_",1,"
- +2 SET DIE=DIC
- SET DR=1
- DO ^DIE
- WO KILL %
- IF $GET(^DIC(6910,1,0))=""
- SET %=2
- +1 WRITE !!,"Should a work order be generated for this line item"
- DO YN^DICN
- +2 IF %=-1
- IF %Y="^"
- SET DUOUT="^"
- QUIT
- +3 IF %=0
- Begin DoDot:1
- +4 WRITE !!,"Please enter 'Y'es if Engineering must disconnect or otherwise support the turn-in of this equipment."
- End DoDot:1
- GOTO WO
- +5 SET C=$SELECT(%=1:"Y",1:"N")
- SET $PIECE(^PRCN(413.1,TDA,1,TI,0),U,4)=C
- +6 IF C'="Y"
- QUIT
- +7 SET PRCNSRV=$PIECE(^PRCN(413.1,TDA,0),U,3)
- +8 DO TRNIN^ENWONEW2
- +9 IF $GET(ENDA)=""
- WRITE !,"Not able to create work order at this time!"
- GOTO WO
- +10 SET DA(1)=TDA
- SET DA=TI
- SET DIC="^PRCN(413.1,"_DA(1)_",1,"
- SET DIE=DIC
- SET WOFL=1
- +11 SET DR="11////^S X=ENDA"
- DO ^DIE
- IQ KILL NL,WODATA,C,CODES,II,S,PRCNFL,ENDR,ENLO,ENHI,PRCNSRV,ENDA,ENWO
- +1 QUIT
- WOC ; Work order completion
- +1 SET TDA=""
- FOR
- SET TDA=$ORDER(^PRCN(413.1,"AC",21,TDA))
- if TDA=""
- QUIT
- DO CS
- +2 KILL TDA
- QUIT
- CS ; Check if all work orders have been completed
- +1 SET N=0
- FOR
- SET N=$ORDER(^PRCN(413.1,TDA,1,N))
- if N'>0
- QUIT
- Begin DoDot:1
- +2 SET WODA=$PIECE(^PRCN(413.1,TDA,1,N,0),U,14)
- if WODA=""
- QUIT
- +3 IF $PIECE($GET(^ENG(6920,WODA,5)),U,2)'=""
- SET DA=TDA
- SET DIE=413.1
- SET DR="6////^S X=25;7////^S X=DT"
- DO ^DIE
- End DoDot:1
- +4 KILL DA,DIE,DR,N,WODA
- +5 QUIT
- PRT ; Print turnin item
- +1 NEW X,Y,N,F,I
- +2 SET TDA=D0
- SET TI=D1
- SET NL=0
- DO TURNIN^PRCNPRNT
- +3 KILL F,FF,FN,GLO,I,IN,J,N,N2,NEWL,NL,OGLO,OID,OIN,OPC,PC,PGLO,PRCNDD
- +4 KILL PRCNDEEP,PGL,PV,TDA,TI,VAL,CODES
- +5 QUIT
- EXIT KILL PRCNTDA,DIC,DIE,DR,DA,DUOUT,IN,Y,C,%,WOFL,SFL,D0,D1,D,TDA,CODE,CODES
- +1 KILL CP,DIR,PGL,OIN,PC,PRCNCT,L,OGLO,OID,OPC
- +2 QUIT