source: FOIAVistA/trunk/r/GENERIC_CODE_SHEET-GEC/GECSEDIT.m@ 1245

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1GECSEDIT ;WISC/RFJ/KLD-create and edit code sheets ;13 Oct 98
2 ;;2.0;GCS;**2,6,9,15,19,27**;MAR 14, 1995
3 ;
4 N %,DONTASK,GECS,GECSFLAG,GECSFXIT
5 D ^GECSSITE Q:'$G(GECS("SITE"))
6 I $L($G(GECSSYS)) S DONTASK=1
7 W ! D BATTYPE^GECSUSEL($G(GECSSYS),$G(DONTASK)) Q:'$G(GECS("BATDA"))
8 F W ! D TRANTYPE^GECSUSEL($G(GECSSEGM),0) Q:$G(GECSFLAG) I $G(GECS("TTDA")) D
9 . I $D(GECSFKP) S GECS("EDIT")=GECSFKP
10 . D NEWCS I '$G(GECS("CSDA")) Q
11 . I GECS("SYSID")="AMS" D AMIS I '$G(GECS("CSDA")) Q
12 . S %=$$CSEDIT
13 . I %<0 D KILLCS^GECSPUR1(GECS("CSDA")) W " << CODE SHEET DELETED >>" Q
14 . I '%!($G(GECSFXIT)) D DELASK^GECSUTIL(GECS("CSDA")) I '$D(^GECS(2100,+$G(GECS("CSDA")),0)) Q
15 . I '$$MAPDATA^GECSXBLD(GECS("CSDA")) Q
16 . D ASKTOBAT^GECSXBL1(GECS("CSDA"))
17 Q
18 ;
19 ;
20NEWCS ; get new code sheet number
21 ; return gecs("csname"),gecs("csda")
22 N %,%DT,%Y,COUNTER,D0,DA,DI,DIC,DIE,DLAYGO,DQ,DR,GECSNAME,X,Y
23 K GECS("CSNAME"),GECS("CSDA")
24 F S COUNTER=$$COUNTER^GECSUNUM(GECS("SITE")_"-"_GECS("SYSID")_"-"_GECS("FY")) Q:'COUNTER D Q:COUNTER
25 . S X=COUNTER_"-"_GECS("FY")
26 . ; entry already in file 2100, get next counter
27 . I $D(^GECS(2100,"B",X)) S COUNTER=0 Q
28 . S DIC="^GECS(2100,",DIC(0)="LZ",DLAYGO=2100 D ^DIC K DLAYGO I Y'>0 S COUNTER=0 Q
29 . ; existing entry selected
30 . I '$P(Y,"^",3) S COUNTER=0 Q
31 I 'COUNTER Q
32 ;
33 W !!,"This code sheet has been assigned IDENTIFICATION NUMBER: ",$P(Y(0),"^")
34 S GECSNAME=$P(Y(0),"^")
35 S DIE="^GECS(2100,",DA=+Y
36 S DR="1///"_GECS("SYSID")_";5///"_GECS("SITE")_";Q;6///"_GECS("SITE1")_";7///"_GECS("TT")_";9///NOW;9.01////"_$P(GECS("PER"),"^")_";10///"_GECS("EDIT")_";2///"_GECS("BATDA")
37 D ^DIE I $D(Y) W !,"UNABLE TO CREATE CODE SHEET!" Q
38 S GECS("CSDA")=DA,GECS("CSNAME")=GECSNAME
39 Q
40 ;
41 ;
42CSEDIT() ; edit code sheet gecs(csda)
43 ; return -1 if code sheet not edit (for fms docs)
44 ; return 0 if ^ entered
45 N %,%X,%Y,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
46 K GECSFXIT
47 W !
48 S (DIC,DIE)="^GECS(2100,",DA=GECS("CSDA")
49 ; edit control segment for fms
50 I GECS("SYSID")="FMS" S DR="[PRCFMS:CONTROL]" W !!?5,"-- FMS Control Segment Data --" D ^DIE I $D(Y) Q -1
51 S DR=GECS("EDIT")
52 I GECS("SYSID")="FMS" W !!?5,"-- FMS Document Data --"
53 I GECS("EDIT")["KEYPUNCH" W !?4 F %=1:1:75 W $S(%#10=0:$E(%),%#5=0:"+",1:".")
54 D ^DIE
55 I $D(Y) Q 0
56 Q 1
57 ;
58 ;
59EDIT ; edit selected code sheet
60 N %,GECS,GECSDA,GECSFXIT,GECSSTAT,GECSBTYP,ABORT,DIR
61 D ^GECSSITE Q:'$D(GECS("SITE"))
62 W ! D BATTYPE^GECSUSEL($G(GECSSYS),$S($L($G(GECSSYS)):1,1:0)) Q:'$G(GECS("BATDA"))
63 S GECSBTYP=GECS("BATCH"),ABORT=0
64 F S GECSDA=$$CODESHET^GECSUSEL(GECSBTYP) Q:'GECSDA D
65 . D VARIABLE^GECSUTIL(GECSDA)
66 . Q:$G(SITEM)
67 . I $G(GECS("TRANSFMSDA"))'="" D Q:ABORT
68 . . I $$GET1^DIQ(2100.1,GECS("TRANSFMSDA"),3,"I")="F" D Q:ABORT
69 . . . W !!,"Current Status: Warning - "_$$GET1^DIQ(2100.1,GECS("TRANSFMSDA"),3,"E"),!
70 . . . S ABORT=1
71 . . . S DIR(0)="E",DIR("A")="Enter RETURN or '^' to exit"
72 . . . D ^DIR
73 . . . Q
74 . I $G(GECS("CSDA")) D Q
75 . . W ! S GECSSTAT=$$STATUS^GECSUSTA(GECS("CSDA")) W !
76 . . I GECS("SYSID")="AMS" D AMIS I '$G(GECS("CSDA")) Q
77 . . S %=$$CSEDIT
78 . . I %<0!($G(GECSFXIT))
79 . . I '$$MAPDATA^GECSXBLD(GECS("CSDA")) Q
80 . . I GECSSTAT=0 D ASKTOBAT^GECSXBL1(GECS("CSDA")) Q
81 . . I GECSSTAT=3,GECS("SYSID")="FMS" D ASKTOBAT^GECSXBL1(GECS("CSDA")) Q
82 . . I GECSSTAT=3,$$ASKREBAT^GECSMUT1 S %=$$MARKBAT^GECSMUT1(GECS("CSDA"))
83 . D ERROR^GECSUTIL(GECSDA)
84 Q
85 ;
86 ;
87AMIS ; ask amis month-year if system id = AMS
88 N %,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
89 S (DIC,DIE)="^GECS(2100,",DA=GECS("CSDA"),DR=9.1 D ^DIE
90 I $D(Y) K GECS("CSDA")
91 Q
92 ;
93 ;
94KEY ; keypunch a code sheet
95 ; set variable gecsfkp=[input template]
96 N GECSFKP
97 S GECSFKP="[GECS KEYPUNCH]" D GECSEDIT
98 Q
Note: See TracBrowser for help on using the repository browser.