Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCNTIPP

PRCNTIPP.m

Go to the documentation of this file.
  1. 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
  1. SELECT ; Select a Turn-in request
  1. N PRCNFLAG S PRCNFLAG=0 ; PRCN*1.0*15
  1. D WOC,FAC^PRCNFAP,FDC^PRCNFAP S PRCNFLAG=PRCNFLAG+1
  1. S DIC(0)="AEQZ",DIC="^PRCN(413.1,"
  1. I PRCNUSR=2 S DIC("S")="I $P(^(0),U,7)=23"
  1. I PRCNUSR=1 S DIC("S")="I $P(^(0),U,7)=6!($P(^(0),U,7)=25)"
  1. D ^DIC K DIC("S") G EXIT:+Y<0
  1. PR S (IN,PRCNTDA,DA)=+Y,TIF=1 D SETUP^PRCNTIPR
  1. K F,FF,FN,ID,PRCNDD,PRCNDEEP,PV,TIF
  1. I PRCNUSR=2 D G SELECT
  1. . S TDA=PRCNTDA,STAT=44,CKA=1 D CK^PRCNFAP I SFL D SQ Q
  1. . S DR="[PRCNTIPPM]",DIE=413.1 W ! D ^DIE
  1. . D:'POP RESET^PRCNUTL ; PRCN*1.0*15
  1. . D SQ
  1. . K POP ; PRCN*1.0*15
  1. S TDA=DA,TI=0,STAT=$P(^PRCN(413.1,TDA,0),U,7),WOFL=0
  1. I STAT=25 D WH,SQ G SELECT
  1. F S TI=$O(^PRCN(413.1,TDA,1,TI)) Q:TI'>0 D Q:$D(DUOUT)
  1. . S WOFL=0 D ITEM Q:$D(DUOUT)
  1. . I 'WOFL D WH Q
  1. . I WOFL S DA=TDA,(DIC,DIE)=413.1,DR="6////^S X=21;7////^S X=DT" D ^DIE,SQ Q
  1. D SQ
  1. G SELECT
  1. WH W !,"Is this request ready to go to Warehouse for pickup"
  1. QH S %=1 D YN^DICN
  1. I %=0 D G QH
  1. . W !!,"Enter 'Yes' to send the turn-in request to Warehouse user."
  1. I %=1 S DA=TDA,DIE=413.1,DR="6////^S X=22;7////^S X=DT" D ^DIE
  1. SQ K DIC,DIE,DR,DA,DUOUT,IN,Y,C,%,WOFL,SFL
  1. Q
  1. ITEM ; Display and process line items
  1. S NL=0 D TURNIN^PRCNPRNT
  1. S WODATA=IN_U_$P($G(^ENG(6914,IN,3)),U,5)
  1. COND ; Get the condition code
  1. S DA(1)=TDA,DA=TI,DIC="^PRCN(413.1,"_DA(1)_",1,"
  1. S DIE=DIC,DR=1 D ^DIE
  1. WO K % I $G(^DIC(6910,1,0))="" S %=2
  1. W !!,"Should a work order be generated for this line item" D YN^DICN
  1. I %=-1,%Y="^" S DUOUT="^" Q
  1. I %=0 D G WO
  1. . W !!,"Please enter 'Y'es if Engineering must disconnect or otherwise support the turn-in of this equipment."
  1. S C=$S(%=1:"Y",1:"N"),$P(^PRCN(413.1,TDA,1,TI,0),U,4)=C
  1. I C'="Y" Q
  1. S PRCNSRV=$P(^PRCN(413.1,TDA,0),U,3)
  1. D TRNIN^ENWONEW2
  1. I $G(ENDA)="" W !,"Not able to create work order at this time!" G WO
  1. S DA(1)=TDA,DA=TI,DIC="^PRCN(413.1,"_DA(1)_",1,",DIE=DIC,WOFL=1
  1. S DR="11////^S X=ENDA" D ^DIE
  1. IQ K NL,WODATA,C,CODES,II,S,PRCNFL,ENDR,ENLO,ENHI,PRCNSRV,ENDA,ENWO
  1. Q
  1. WOC ; Work order completion
  1. S TDA="" F S TDA=$O(^PRCN(413.1,"AC",21,TDA)) Q:TDA="" D CS
  1. K TDA Q
  1. CS ; Check if all work orders have been completed
  1. S N=0 F S N=$O(^PRCN(413.1,TDA,1,N)) Q:N'>0 D
  1. . S WODA=$P(^PRCN(413.1,TDA,1,N,0),U,14) Q:WODA=""
  1. . 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
  1. K DA,DIE,DR,N,WODA
  1. Q
  1. PRT ; Print turnin item
  1. NEW X,Y,N,F,I
  1. S TDA=D0,TI=D1,NL=0 D TURNIN^PRCNPRNT
  1. K F,FF,FN,GLO,I,IN,J,N,N2,NEWL,NL,OGLO,OID,OIN,OPC,PC,PGLO,PRCNDD
  1. K PRCNDEEP,PGL,PV,TDA,TI,VAL,CODES
  1. Q
  1. EXIT K PRCNTDA,DIC,DIE,DR,DA,DUOUT,IN,Y,C,%,WOFL,SFL,D0,D1,D,TDA,CODE,CODES
  1. K CP,DIR,PGL,OIN,PC,PRCNCT,L,OGLO,OID,OPC
  1. Q