source: WorldVistAEHR/trunk/r/EQUIPMENT_TURN_IN_REQUEST-PRCN/PRCNTIPP.m@ 861

Last change on this file since 861 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1PRCNTIPP ;SSI/SEB,ALA-PPM Turn-in review ;[ 05/31/96 10:34 AM ]
2 ;;1.0;Equipment/Turn-In Request;**15**;Sep 13, 1996
3SELECT ; Select a Turn-in request
4 N PRCNFLAG S PRCNFLAG=0 ; PRCN*1.0*15
5 D WOC,FAC^PRCNFAP,FDC^PRCNFAP S PRCNFLAG=PRCNFLAG+1
6 S DIC(0)="AEQZ",DIC="^PRCN(413.1,"
7 I PRCNUSR=2 S DIC("S")="I $P(^(0),U,7)=23"
8 I PRCNUSR=1 S DIC("S")="I $P(^(0),U,7)=6!($P(^(0),U,7)=25)"
9 D ^DIC K DIC("S") G EXIT:+Y<0
10PR S (IN,PRCNTDA,DA)=+Y,TIF=1 D SETUP^PRCNTIPR
11 K F,FF,FN,ID,PRCNDD,PRCNDEEP,PV,TIF
12 I PRCNUSR=2 D G SELECT
13 . S TDA=PRCNTDA,STAT=44,CKA=1 D CK^PRCNFAP I SFL D SQ Q
14 . S DR="[PRCNTIPPM]",DIE=413.1 W ! D ^DIE
15 . D:'POP RESET^PRCNUTL ; PRCN*1.0*15
16 . D SQ
17 . K POP ; PRCN*1.0*15
18 S TDA=DA,TI=0,STAT=$P(^PRCN(413.1,TDA,0),U,7),WOFL=0
19 I STAT=25 D WH,SQ G SELECT
20 F S TI=$O(^PRCN(413.1,TDA,1,TI)) Q:TI'>0 D Q:$D(DUOUT)
21 . S WOFL=0 D ITEM Q:$D(DUOUT)
22 . I 'WOFL D WH Q
23 . I WOFL S DA=TDA,(DIC,DIE)=413.1,DR="6////^S X=21;7////^S X=DT" D ^DIE,SQ Q
24 D SQ
25 G SELECT
26WH W !,"Is this request ready to go to Warehouse for pickup"
27QH S %=1 D YN^DICN
28 I %=0 D G QH
29 . W !!,"Enter 'Yes' to send the turn-in request to Warehouse user."
30 I %=1 S DA=TDA,DIE=413.1,DR="6////^S X=22;7////^S X=DT" D ^DIE
31SQ K DIC,DIE,DR,DA,DUOUT,IN,Y,C,%,WOFL,SFL
32 Q
33ITEM ; Display and process line items
34 S NL=0 D TURNIN^PRCNPRNT
35 S WODATA=IN_U_$P($G(^ENG(6914,IN,3)),U,5)
36COND ; Get the condition code
37 S DA(1)=TDA,DA=TI,DIC="^PRCN(413.1,"_DA(1)_",1,"
38 S DIE=DIC,DR=1 D ^DIE
39WO K % I $G(^DIC(6910,1,0))="" S %=2
40 W !!,"Should a work order be generated for this line item" D YN^DICN
41 I %=-1,%Y="^" S DUOUT="^" Q
42 I %=0 D G WO
43 . W !!,"Please enter 'Y'es if Engineering must disconnect or otherwise support the turn-in of this equipment."
44 S C=$S(%=1:"Y",1:"N"),$P(^PRCN(413.1,TDA,1,TI,0),U,4)=C
45 I C'="Y" Q
46 S PRCNSRV=$P(^PRCN(413.1,TDA,0),U,3)
47 D TRNIN^ENWONEW2
48 I $G(ENDA)="" W !,"Not able to create work order at this time!" G WO
49 S DA(1)=TDA,DA=TI,DIC="^PRCN(413.1,"_DA(1)_",1,",DIE=DIC,WOFL=1
50 S DR="11////^S X=ENDA" D ^DIE
51IQ K NL,WODATA,C,CODES,II,S,PRCNFL,ENDR,ENLO,ENHI,PRCNSRV,ENDA,ENWO
52 Q
53WOC ; Work order completion
54 S TDA="" F S TDA=$O(^PRCN(413.1,"AC",21,TDA)) Q:TDA="" D CS
55 K TDA Q
56CS ; Check if all work orders have been completed
57 S N=0 F S N=$O(^PRCN(413.1,TDA,1,N)) Q:N'>0 D
58 . S WODA=$P(^PRCN(413.1,TDA,1,N,0),U,14) Q:WODA=""
59 . 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
60 K DA,DIE,DR,N,WODA
61 Q
62PRT ; Print turnin item
63 NEW X,Y,N,F,I
64 S TDA=D0,TI=D1,NL=0 D TURNIN^PRCNPRNT
65 K F,FF,FN,GLO,I,IN,J,N,N2,NEWL,NL,OGLO,OID,OIN,OPC,PC,PGLO,PRCNDD
66 K PRCNDEEP,PGL,PV,TDA,TI,VAL,CODES
67 Q
68EXIT K PRCNTDA,DIC,DIE,DR,DA,DUOUT,IN,Y,C,%,WOFL,SFL,D0,D1,D,TDA,CODE,CODES
69 K CP,DIR,PGL,OIN,PC,PRCNCT,L,OGLO,OID,OPC
70 Q
Note: See TracBrowser for help on using the repository browser.