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

PRCD1F.m

Go to the documentation of this file.
  1. PRCD1F ;WISC/PLT-SUBSTATION ENTER/EDIT ; 08/03/95 2:33 PM
  1. V ;;5.1;IFCAP;;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. QUIT ;invalid entry
  1. ;
  1. ;enter/edit substation
  1. EN N PRCDD,PRCDR,PRCRI,PRCAED,PRCQT,PRCU,A,B,X,Y S PRCU="^"
  1. N PRCUQ
  1. F D EN^DDIOL($TR($J("",78)," ","-")) D Q:PRCQT=1
  1. . S PRCDD=411,PRCQT=""
  1. . S PRCUQ=""
  1. . D LKUP Q:PRCQT
  1. . S PRCLOCK=$$DICGL^PRC0B1(PRCDD)_PRCRI(PRCDD)_",",Y=3 D ICLOCK^PRC0B(PRCLOCK,.Y)
  1. . I 'Y D EN^DDIOL("File is in use, please try later!") QUIT
  1. . D EDIT
  1. . D DCLOCK^PRC0B(PRCLOCK)
  1. . QUIT
  1. QUIT
  1. ;
  1. LKUP ;lookup prcdd=411
  1. S DA="",X("S")="I +Y>1000000"
  1. S DA="" D LOOKUP^PRC0B(.X,.Y,PRCDD,"AEMOQLS","Select SUBSTATION: ")
  1. I Y<0!(X="") S PRCQT=1 QUIT
  1. S DA=+Y,PRCRI(PRCDD)=+Y,PRCAED=$P(Y,"^",3)
  1. I PRCAED=1,DA<1000000!($P(Y,"^",2)?3N) D EN^DDIOL("Use option 'Site Parameters' to add new station.") D DELETE S PRCQT=2
  1. I PRCAED=1,'$D(^PRC(411,$E($P(Y,"^",2),1,3),0)) D EN^DDIOL("Use option 'Site Parameters' to set up the parent station first.") D DELETE S PRCQT=2
  1. QUIT
  1. ;
  1. EDIT ;edit prcdd=411
  1. S PRCDR="[PRCD SUBSTATION]",C=PRCDR
  1. ED1 D EDIT^PRC0B(.X,PRCDD_";;"_PRCRI(PRCDD),C) I X=0 S PRCQT=2 QUIT
  1. I X=-1,PRCAED=1 D Q:PRCQT
  1. . D YN^PRC0A(.X,.Y,"Delete this NEW entry","","No")
  1. . I Y=1 D DELETE I PRCAED=-1 D EN^DDIOL(" **** NEW ENTRY DELETED ****") S PRCQT=3 QUIT
  1. . D EN^DDIOL(" **** NEW ENTRY IS NOT DELETED ****")
  1. .QUIT
  1. ;require fileds check
  1. S C="101;"
  1. EDA K A D PIECE^PRC0B(PRCDD_";;"_PRCRI(PRCDD),C,"I","A")
  1. S C="" F A=101 I $G(A(PRCDD,PRCRI(PRCDD),A,"I"))="" S C=C_A_";"
  1. K A I C]"" D EN^DDIOL(" **** Missing Required Field(s) ****") S C=C_"S Y=0;"_PRCDR G ED1
  1. QUIT
  1. ;
  1. DELETE ;delete prcdd=411
  1. D DELETE^PRC0B1(.X,PRCDD_";^PRC(411,;"_PRCRI(PRCDD))
  1. S:X=1 PRCAED=-1
  1. QUIT
  1. ;
  1. EN1 ;print file 411
  1. N L,DIC,FLDS,BY,FR,TO,DHD,PRCDD
  1. S PRCDD=411
  1. S L=0,DIC=PRCDD,FLDS=".01,.1,.5,19.2"
  1. S BY="@.01",FR="@",TO="~"
  1. D EN1^DIP
  1. QUIT
  1. ;