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

PRCNUTL1.m

Go to the documentation of this file.
  1. PRCNUTL1 ;SSI/ALA-Utility Program ;[ 04/24/96 2:12 PM ]
  1. ;;1.0;Equipment/Turn-In Request;**5,17**;Sep 13, 1996;Build 4
  1. LOC ; Translate location field into pointer and store it
  1. ;
  1. ;PRCN*1.0*17 Modified vendor lookup/set to insure the DIE
  1. ; value remained at '^PRCN(413,'. Also, for
  1. ; null Training Vendor set additional Training
  1. ; Vendor Name to null, besides Vendor Training
  1. ; pointer field in file 413 to null.
  1. ;
  1. N DIEL,DM,DC,DH,DI,DK,DP,DL,DIFLD,DQ,DR,DIC,DA,X,Y
  1. S X=$P($G(^PRCN(413,D0,2)),U,11),DIC(0)="EZ"
  1. S DIC="^ENG(""SP""," D ^DIC I +Y<0 S $P(^PRCN(413,D0,2),U,19)="" Q
  1. S DR="26////"_$P(Y,U,2)_";26.5////"_+Y,DA=D0 D ^DIE
  1. Q
  1. LOCHLP ; Executable help for Location field
  1. S DUOUT=0,PRCNCT=0,HL0=0
  1. F S HL0=$O(^DD(413,26,21,HL0)) Q:HL0'>0 W !,^DD(413,26,21,HL0,0)
  1. W !!,"Locations currently in the space file:"
  1. S L="" F S L=$O(^ENG("SP","B",L)) Q:L="" D T I $G(DUOUT)=1 S DUOUT=0 Q
  1. K L,PRCNDI,PRCND,PRCNA,X
  1. Q
  1. VEN ; Translate training vendor field into pointer and store it
  1. N DIEL,DM,DC,DH,DI,DK,DP,DL,DIFLD,DQ,DR,DIC,DA,X,Y
  1. S X=$P($G(^PRCN(413,D0,7)),U,4),DIC(0)="EZ"
  1. S DIC="^PRC(440," D ^DIC I +Y<0 S DA=D0,DR="55.5///@" D ^DIE Q ;PRCN*1.0*17
  1. S DR="55////"_$P(Y,U,2)_";55.5////"_+Y,DA=D0 D ^DIE
  1. Q
  1. VENHLP ; Executable help for training vendor field
  1. S DUOUT=0,PRCNCT=0,HL0=0
  1. F S HL0=$O(^DD(413,55,21,HL0)) Q:HL0'>0 W !,^DD(413,55,21,HL0,0)
  1. W !!,"Current Vendors: "
  1. S L="" F S L=$O(^PRC(440,"B",L)) Q:L="" D T I $G(DUOUT)=1 S DUOUT=0 Q
  1. K L,PRCNDI,PRCND,PRCNA,X
  1. Q
  1. EQHLP ; Special help for screening items from Equipment Inventory
  1. S PRCND=$X,PRCNDI=21,PRCNCT=0
  1. S:$G(PRCNCMR)="" PRCNCMR=$P(^PRCN(413.1,DA,0),U,16)
  1. S N=0 F S N=$O(^ENG(6914,N)) Q:N'>0 D I $G(DUOUT)=1 S DUOUT=0 Q
  1. . I $D(^PRCN(413.1,"AB",N)) Q
  1. . S ACQ=$P($G(^ENG(6914,N,3)),U,4) I ACQ'="P"&(ACQ'="M")&(ACQ'="O")&(ACQ'="") Q
  1. . I $P($G(^ENG(6914,N,2)),U,9)'=PRCNCMR Q
  1. . S L=N_" "_$P(^ENG(6914,N,0),U,2) D T I $G(DUOUT)=1 Q
  1. K PRCNDI,PRCND,PRCNA,N,ACQ
  1. Q
  1. T S PRCNCT=PRCNCT+1
  1. I PRCNCT<10 W !,L Q
  1. R !,"'^' TO STOP: ",PRCNA:DTIME S:'$T PRCNA=U
  1. I $G(PRCNA)[U S DUOUT=1 Q
  1. S PRCNCT=0
  1. Q
  1. UCK ; Check for user type and set screen
  1. I $D(^XUSEC("PRCNPPM",DUZ)) Q
  1. I $D(^XUSEC("PRCNCMR",DUZ)) S DIC("S")="I $P(^(0),U,6)=DUZ" Q
  1. I $D(^XUSEC("PRCNWHSE",DUZ)) S DIC("S")="I $P(^(0),U,7)=22" Q
  1. E S DIC("S")="I $P(^(0),U,2)=DUZ"
  1. Q