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 Dec 13, 2024@01:54:43 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
