| 1 | PRCNUTL1 ;SSI/ALA-Utility Program ;[ 04/24/96 2:12 PM ]
|
|---|
| 2 | ;;1.0;Equipment/Turn-In Request;**5**;Sep 13, 1996
|
|---|
| 3 | LOC ; 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
|
|---|
| 9 | LOCHLP ; 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
|
|---|
| 16 | VEN ; 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
|
|---|
| 22 | VENHLP ; 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
|
|---|
| 29 | EQHLP ; 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
|
|---|
| 39 | T 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
|
|---|
| 45 | UCK ; 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
|
|---|
