source: WorldVistAEHR/trunk/r/EQUIPMENT_TURN_IN_REQUEST-PRCN/PRCNUTL1.m@ 792

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

initial load of WorldVistAEHR

File size: 2.0 KB
RevLine 
[613]1PRCNUTL1 ;SSI/ALA-Utility Program ;[ 04/24/96 2:12 PM ]
2 ;;1.0;Equipment/Turn-In Request;**5**;Sep 13, 1996
3LOC ; Translate location field into pointer and store it
4 N DIEL,DM,DC,DH,DI,DK,DP,DL,DIFLD,DQ,DR,DIC,DA,X,Y
5 S X=$P($G(^PRCN(413,D0,2)),U,11),DIC(0)="EZ"
6 S DIC="^ENG(""SP""," D ^DIC I +Y<0 S $P(^PRCN(413,D0,2),U,19)="" Q
7 S DR="26////"_$P(Y,U,2)_";26.5////"_+Y,DA=D0 D ^DIE
8 Q
9LOCHLP ; Executable help for Location field
10 S DUOUT=0,PRCNCT=0,HL0=0
11 F S HL0=$O(^DD(413,26,21,HL0)) Q:HL0'>0 W !,^DD(413,26,21,HL0,0)
12 W !!,"Locations currently in the space file:"
13 S L="" F S L=$O(^ENG("SP","B",L)) Q:L="" D T I $G(DUOUT)=1 S DUOUT=0 Q
14 K L,PRCNDI,PRCND,PRCNA,X
15 Q
16VEN ; Translate training vendor field into pointer and store it
17 N DIEL,DM,DC,DH,DI,DK,DP,DL,DIFLD,DQ,DR,DIC,DA,X,Y
18 S X=$P($G(^PRCN(413,D0,7)),U,4),DIC(0)="EZ"
19 S DIC="^PRC(440," D ^DIC I +Y<0 S $P(^PRCN(413,D0,7),U,16)="",DIE=DIC
20 S DR="55////"_$P(Y,U,2)_";55.5////"_+Y,DA=D0 D ^DIE
21 Q
22VENHLP ; Executable help for training vendor field
23 S DUOUT=0,PRCNCT=0,HL0=0
24 F S HL0=$O(^DD(413,55,21,HL0)) Q:HL0'>0 W !,^DD(413,55,21,HL0,0)
25 W !!,"Current Vendors: "
26 S L="" F S L=$O(^PRC(440,"B",L)) Q:L="" D T I $G(DUOUT)=1 S DUOUT=0 Q
27 K L,PRCNDI,PRCND,PRCNA,X
28 Q
29EQHLP ; Special help for screening items from Equipment Inventory
30 S PRCND=$X,PRCNDI=21,PRCNCT=0
31 S:$G(PRCNCMR)="" PRCNCMR=$P(^PRCN(413.1,DA,0),U,16)
32 S N=0 F S N=$O(^ENG(6914,N)) Q:N'>0 D I $G(DUOUT)=1 S DUOUT=0 Q
33 . I $D(^PRCN(413.1,"AB",N)) Q
34 . S ACQ=$P($G(^ENG(6914,N,3)),U,4) I ACQ'="P"&(ACQ'="M")&(ACQ'="O")&(ACQ'="") Q
35 . I $P($G(^ENG(6914,N,2)),U,9)'=PRCNCMR Q
36 . S L=N_" "_$P(^ENG(6914,N,0),U,2) D T I $G(DUOUT)=1 Q
37 K PRCNDI,PRCND,PRCNA,N,ACQ
38 Q
39T S PRCNCT=PRCNCT+1
40 I PRCNCT<10 W !,L Q
41 R !,"'^' TO STOP: ",PRCNA:DTIME S:'$T PRCNA=U
42 I $G(PRCNA)[U S DUOUT=1 Q
43 S PRCNCT=0
44 Q
45UCK ; Check for user type and set screen
46 I $D(^XUSEC("PRCNPPM",DUZ)) Q
47 I $D(^XUSEC("PRCNCMR",DUZ)) S DIC("S")="I $P(^(0),U,6)=DUZ" Q
48 I $D(^XUSEC("PRCNWHSE",DUZ)) S DIC("S")="I $P(^(0),U,7)=22" Q
49 E S DIC("S")="I $P(^(0),U,2)=DUZ"
50 Q
Note: See TracBrowser for help on using the repository browser.