source: WorldVistAEHR/trunk/r/LIBRARY-LBR-LBRS/LBRYFINP.m

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

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1LBRYFINP ;SSI/ALA-FORUM INPUT CHECKS ;[ 07/22/97 3:23 PM ]
2 ;;2.5;Library;**2**;Mar 11, 1996
3PP ; Prediction Pattern Input
4 Q:$G(LBRYNEW)=1
5 NEW DIC,DIE,DR,DA
6 S TY=$S(OPP="":"ADDED",NPP="":"DELETED",1:"CHANGED")
7 S TYP="CPT" NEW X D FTRN^LBRYUTL S $P(^LBRY(682.1,LBRYDA,0),U,8)=TY
8 S $P(^LBRY(682.1,LBRYDA,1),U)=$P(^LBRY(680.5,LBRYCLS,0),U)
9 I OPP'="" NEW X,LBRYCLS S LBRYCLS=OPP D PRP^LBRYTRN
10 K OPP,NPP,TY,TYP,LBRYDA
11 Q
12FR ; Frequency Input
13 Q:$G(LBRYNEW)=1
14 NEW DIC,DIE,DR,DA
15 S TY=$S(OFR="":"ADDED",NFR="":"DELETED",1:"CHANGED")
16 S TYP="CFQ" NEW X D FTRN^LBRYUTL S $P(^LBRY(682.1,LBRYDA,0),U,8)=TY
17 S $P(^LBRY(682.1,LBRYDA,1),U)=$P(^LBRY(680.5,LBRYCLS,0),U)
18 I OFR'="" NEW X S FRQ=OFR D FRQ^LBRYTRN
19 K OFR,NFR,TY,TYP,LBRYDA
20 Q
21LS ; Last Issue Input
22 Q:$G(LBRYNEW)=1
23 NEW DIC,DIE,DR,DA
24 Q:$P($G(^LBRY(680.5,LBRYCLS,3)),U,4)=""
25 S TYP="TCP" NEW X D FTRN^LBRYUTL S $P(^LBRY(682.1,LBRYDA,0),U,8)="CEASED"
26 S $P(^LBRY(682.1,LBRYDA,1),U)=$P(^LBRY(680.5,LBRYCLS,0),U)
27 S $P(^LBRY(682.1,LBRYDA,4),U,3)=$P(^LBRY(680.5,LBRYCLS,3),U,4)
28 K OLS,NLS,TYP,LBRYDA
29 Q
30TCN ; SERLINE Unique Identifier input check
31 I $D(X) I $L(X)>9!($L(X)<9) K X Q
32 I $E(X,1,2)="SR",$E(X,3,9)?.N Q
33 I $E(X,1,1)?.A,$E(X,2,9)?.N Q
34 S TXT="SERLINE Title Control Number format is: SR####### or A-Z followed by all numbers"
35 D EN^DDIOL(TXT,"","!!")
36 K X,TCN
37 Q
Note: See TracBrowser for help on using the repository browser.