source: WorldVistAEHR/trunk/r/GENERIC_CODE_SHEET-GEC/GECSUTIL.m@ 1639

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

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1GECSUTIL ;WISC/RFJ/KLD-code sheet utilities ;13 Oct 98
2 ;;2.0;GCS;**1,19**;MAR 14, 1995
3 Q
4 ;
5 ;
6DELASK(GECSDA) ; ask to delete the code sheet gecsda
7 N %,GECSBATC
8 S XP="ARE YOU SURE YOU WANT TO DELETE THE CODE SHEET",XH="Enter 'YES' to delete."
9 W ! I $$YN(2)'=1 S %=$$STATUS^GECSUSTA(GECSDA) Q
10 S GECSBATC=$P($G(^GECS(2100,GECSDA,"TRANS")),"^",9)
11 D KILLCS^GECSPUR1(GECSDA) W " << CODE SHEET DELETED >>"
12 I $L(GECSBATC) D KILLBATC^GECSMUT1(GECSBATC)
13 Q
14 ;
15 ;
16PRINTDQ ; taskman comes here to print code sheet gecsda
17 D PRINT(GECSDA)
18 Q
19 ;
20 ;
21PRINT(GECSDA) ; print code sheet gecsda
22 N %,D,DA1,GECSFLAG,LINE
23 I '$D(IO) S IOP="HOME" D ^%ZIS K IOP
24 W !!,"TRANSMITTED CODE SHEET FOR ID# ",$P(^GECS(2100,GECSDA,0),"^")," WILL BE AS FOLLOWS:",!
25 F %=1:1:79 W $S(%#10=0:$E(%),%#5=0:"+",1:".")
26 S LINE=1,DA1=0 F S DA1=$O(^GECS(2100,GECSDA,"CODE",DA1)) Q:'DA1!($G(GECSFLAG)) S D=$G(^(DA1,0)) I D'="" D
27 . I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C",LINE=20 D Q:$G(GECSFLAG)
28 . . S LINE=1
29 . . D PAUSE Q:$G(GECSFLAG)
30 . . W !! F %=1:1:79 W $S(%#10=0:$E(%),%#5=0:"+",1:".")
31 . W !,D
32 . S LINE=LINE+1
33 W !
34 I LINE>13 D R
35 Q
36 ;
37 ;
38VARIABLE(GECSDA) ; set up variables for code sheet gecsda
39 N D,GECSFLAG,GECSFNOP
40 K GECS
41 S D=$G(^GECS(2100,+GECSDA,0)) I D="" W !,"CODE SHEET MISSING" Q
42 S GECS("CSDA")=+GECSDA
43 S GECS("CSNAME")=$P(D,"^")
44 S GECS("SYSID")=$P(D,"^",2)
45 S GECS("BATDA")=+$P(D,"^",3)
46 S GECS("BATCH")=$P($G(^GECS(2101.1,GECS("BATDA"),0)),"^")
47 S GECS("SITE")=$P(D,"^",6)
48 S GECS("SITE1")=$P(D,"^",7)
49 S GECS("TT")=$P(D,"^",8) S:GECS("TT")="" GECS("TT")=" "
50 S GECS("TTDA")=+$O(^GECS(2101.2,"B",GECS("TT"),0))
51 S GECS("EDIT")=$P(D,"^",11) S:GECS("EDIT")="" GECS("EDIT")="[ ]"
52 S GECS("TRANSFMS")=$P($G(^GECS(2100,+GECSDA,"TRANS")),"^",3)
53 I GECS("TRANSFMS")'="" D
54 . S GECS("TRANSFMSDA")=$O(^GECS(2100.1,"B",GECS("TRANSFMS"),""))
55 ; check variables
56 I GECS("CSNAME")="" W !,"CODE SHEET NAME MISSING" S GECSFLAG=1
57 I GECS("SYSID")="" W !,"SYSTEM IDENTIFIER MISSING" S GECSFLAG=1
58 I GECS("BATCH")="" W !,"BATCH TYPE MISSING" S GECSFLAG=1
59 I 'GECS("SITE") W !,"STATION NUMBER MISSING" S GECSFLAG=1
60 I 'GECS("TTDA") W !,"TRANSACTION TYPE/SEGMENT MISSING" S GECSFLAG=1
61 I '$O(^DIE("B",$E(GECS("EDIT"),2,$L(GECS("EDIT"))-1),0)) W !,"EDIT TEMPLATE MISSING" S GECSFLAG=1
62 I GECS("SITE") S GECSFNOP=1 D GETSITE^GECSSITE($O(^DIC(4,"D",GECS("SITE")_GECS("SITE1"),0))) I '$D(GECS("SITE")) S GECSFLAG=1
63 I $G(GECSFLAG) K GECS
64 Q
65 ;
66 ;
67ERROR(GECSDA) ; error in code sheet variables
68 W !!,"SINCE THERE ARE DATA ERRORS FOR THIS CODE SHEET, IT CANNOT BE EDITTED.",!,"THIS CODE SHEET SHOULD BE DELETED AND RE-ENTERED AS A NEW CODE SHEET."
69 D DELASK^GECSUTIL(GECSDA)
70 Q
71 ;
72 ;
73R ; press return to continue
74 N X U IO(0) W !,"<Press RETURN to continue>" R X:DTIME Q
75 ;
76 ;
77PAUSE ; pause
78 N X U IO(0) W !,"Press RETURN to continue, '^' to exit:" R X:DTIME S:'$T X="^" S:X["^" GECSFLAG=1 U IO Q
79 ;
80 ;
81YN(%) ; yes, no reader
82 ; %=default answer [1=yes,2=no];
83 ; XP=prompt array [none,1,2,3...];
84 ; XH=help array [none,1,2,3...]
85 N I,X
86 I '$G(%) S %=3
87 F D Q:$D(X)
88 . W:$D(XP) !,XP F I=1:1 Q:'$D(XP(I)) W !,XP(I)
89 . W "? ",$P("YES// ^NO// ^<YES/NO> ","^",%)
90 . R X:$S($D(DTIME):DTIME,1:300) E W " <<timeout>>" S X=0 Q
91 . I X["^" S X=0 Q
92 . S:X="" X=% S X=$TR($E(X),"yYnN","1122"),X=+X
93 . I X'=1,X'=2 D HELP K X Q
94 . W:$X>73 ! W $P(" (YES)^ (NO)","^",X)
95 K XH,XP
96 Q X
97 ;
98HELP I '$D(XH) W !,"You must enter a 'Yes' or a 'No', or you may enter an '^' to Quit",!! Q
99 W !,XH F I=1:1 Q:'$D(XH(I)) W !,XH(I)
100 W !
101 Q
Note: See TracBrowser for help on using the repository browser.