source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHLCS.m@ 619

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

initial load of WorldVistAEHR

File size: 972 bytes
Line 
1PRCHLCS ;SF-ISC/TKW-LOG CODE SHEET UTILITY ROUTINES ;9-13-89/2:37 PM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN1 ;SOURCE DEVIATION/SERIAL NO. FIELD, PRCHL500
6 Q:'$D(PRCHCS("CANC"))
7 I PRCHCS("CANC")="" D CHK Q
8 I (X'?4N)!(X'>2000) W !!,"Must be a number greater than 2000!",! K X
9 Q
10 ;
11SD D DSPS W !!,"Select SOURCE DEVIATION CODE: " R X:DTIME I '$T!(X["^")!(X="") S X=" " Q
12 ;
13CHK F Z=0:0 S Z=$O(^PRCD(441.4,"B",X,Z)) Q:'Z I $D(^PRCD(441.4,+Z,0)),$P(^(0),U,2)="S" Q
14 I 'Z D W1 G SD
15 W " "_$P(^PRCD(441.4,Z,0),U,3)
16 S %=1 W !,"RIGHT OPTION " D YN^DICN D:%=0 DSPS G:%'=1 SD S X=" "_X Q
17 ;
18DSPS W !! F I=0:0 S I=$O(^PRCD(441.4,I)) Q:'I I $D(^(I,0)),$P(^(0),U,2)="S" W $P(^(0),U,1)_" "_$P(^(0),U,3),!
19 Q
20 ;
21W1 W $C(7),!,"?? INVALID SELECTION",!! K X
22 Q
23 ;
24EN2 ;ONLINE HELP FOR SOURCE DEVIATION/SERIAL NO.
25 Q:'$D(PRCHCS("CANC")) I PRCHCS("CANC")="" D DSPS Q
26 W $C(7),!!,"Enter 4 digit Serial Number",!
27 Q
Note: See TracBrowser for help on using the repository browser.