source: WorldVistAEHR/trunk/r/GENERIC_CODE_SHEET-GEC/GECSMUT1.m@ 1361

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

initial load of WorldVistAEHR
File size: 4.7 KB
RevLine 
[613]1GECSMUT1 ;WISC/RFJ-maintenance utilities (batching) ;01 Nov 93
2 ;;2.0;GCS;**2,6**;MAR 14, 1995
3 ;edited by IRMFO-SF/RJH 12-95
4 Q
5 ;
6MARKBAT(DA) ; mark code sheet da for batching
7 ; return 1 for marked, 0 for unmarked
8 N %,%DT,D0,DI,DIC,DIE,DQ,DR,X,Y
9 S %=$G(^GECS(2100,DA,0)) I %="" Q 0
10 W !!?5,"** CODE SHEET NUMBER: ",$P(%,"^")," **"
11 S DR=".15///@;.8///@;.1///Y;.95////"_DUZ_";"
12 I $G(GECSAUTO)="BATCH" S DR=DR_".6///TODAY;.9///3;"
13 E S DR=DR_".6//TODAY;.9//3;"
14 S (DIC,DIE)="^GECS(2100," W ! D ^DIE
15 ; ^ entered, retain in file
16 I $D(Y) D RETAIN^GECSUSTA(DA) S %=$$STATUS^GECSUSTA(DA) Q 0
17 I $G(GECSAUTO)="BATCH" W !,"CODE SHEET AUTOMATICALLY MARKED FOR BATCHING !" Q 1
18 S %=$$STATUS^GECSUSTA(DA)
19 Q 1
20 ;
21ASKREBAT() ; ask to rebatch
22 ; return 1 for yes, 0 for no
23 S XP="DO YOU WANT TO MARK FOR REBATCHING",XH="'YES' to mark for rebatching.",XH(1)="'NO' or '^' to abort."
24 I $$YN^GECSUTIL(2)'=1 Q 0
25 Q 1
26 ;
27REMARK ; remark a code sheet for batching
28 N %,GECS,GECSBATC,GECSDA,GECSSTAT,GECSBTYP
29 D ^GECSSITE Q:'$D(GECS("SITE"))
30 D BATNOFMS^GECSUSEL Q:'$G(GECS("BATDA"))
31 S GECSBTYP=GECS("BATCH")
32 F S GECSDA=$$CODESHET^GECSUSEL(GECSBTYP) Q:'GECSDA D
33 . D VARIABLE^GECSUTIL(GECSDA)
34 . I $G(GECS("SYSID"))="FMS" W !,"*** FMS DOCUMENTS DO NOT HAVE TO BE BATCHED ***" Q
35 . I $G(GECS("CSDA")) D Q
36 . . W ! S GECSSTAT=$$STATUS^GECSUSTA(GECS("CSDA")) W !
37 . . S GECSBATC=$P($G(^GECS(2100,GECS("CSDA"),"TRANS")),"^",9)
38 . . I GECSBATC="" W !,"YOU CAN ONLY SELECT CODE SHEETS WHICH HAVE BEEN MARKED FOR BATCHING." Q
39 . . I $$ASKREBAT S %=$$MARKBAT(GECS("CSDA")) D KILLBATC(GECSBATC) Q
40 . D ERROR^GECSUTIL(GECSDA)
41 Q
42 ;
43REVIEW ; review code sheets waiting to be batched
44 N %,GECS,GECSDA,GECSSTAT,GECSBTYP
45 D ^GECSSITE Q:'$D(GECS("SITE"))
46 W ! D BATTYPE^GECSUSEL($G(GECSSYS),$S($L($G(GECSSYS)):1,1:0)) Q:'$G(GECS("BATDA"))
47 S GECSBTYP=GECS("BATCH")
48 F S GECSDA=$$CODESHET^GECSUSEL(GECSBTYP) Q:'GECSDA D
49 . D VARIABLE^GECSUTIL(GECSDA)
50 . I $G(GECS("CSDA")) D Q
51 . . W ! S GECSSTAT=$$STATUS^GECSUSTA(GECS("CSDA")) W !
52 . . I GECS("SYSID")'="FMS",$P($G(^GECS(2100,GECS("CSDA"),"TRANS")),"^")'="Y" W !,"YOU CAN ONLY SELECT CODE SHEETS WHICH HAVE BEEN MARKED FOR BATCHING." Q
53 . . I GECS("SYSID")="FMS",$P($G(^GECS(2100,GECS("CSDA"),"TRANS")),"^",3)'="" W !,"YOU CAN ONLY SELECT FMS DOCUMENTS WHICH HAVE NOT BEEN TRANSMITTED." Q
54 . . I '$$MAPDATA^GECSXBLD(GECS("CSDA")) Q
55 . . D ASKTOBAT^GECSXBL1(GECS("CSDA"))
56 . D ERROR^GECSUTIL(GECSDA)
57 Q
58 ;
59DELETE ; delete selected code sheets
60 N %,GECS,GECSDA,GECSSTAT,GECSBTYP
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")
64 F S GECSDA=$$CODESHET^GECSUSEL(GECSBTYP) Q:'GECSDA D
65 . D VARIABLE^GECSUTIL(GECSDA)
66 . W ! S GECSSTAT=$$STATUS^GECSUSTA(GECSDA) W !
67 . D DELASK^GECSUTIL(GECSDA)
68 Q
69 ;
70EDITBAT ; edit code sheet batch
71 N %,GECS,GECSBATC,GECSDA,GECSDICS,GECSSTAT,GECSBTYP
72 D ^GECSSITE Q:'$G(GECS("SITE"))
73 D BATNOFMS^GECSUSEL Q:'$G(GECS("BATDA"))
74 S GECSBTYP=GECS("BATCH")
75 F S GECSDA=$$CODESHET^GECSUSEL(GECSBTYP) Q:'GECSDA D
76 . D VARIABLE^GECSUTIL(GECSDA)
77 . I $G(GECS("CSDA")) D Q
78 . . W ! S GECSSTAT=$$STATUS^GECSUSTA(GECS("CSDA")) W !
79 . . I '$D(^GECS(2100,GECS("CSDA"),"TRANS")) W !,"CODE SHEET MUST BE READY FOR BATCHING BEFORE THE BATCH NUMBER CAN BE EDIT.",!,"USE THE 'Code Sheet Edit' OPTION." Q
80 . . I $P($G(^GECS(2100,GECS("CSDA"),"TRANS")),"^",9)'="" D Q:%=0
81 . . . S XP="Do you want to DELETE this batch number",XH="Enter 'YES' to DELETE batch number, 'NO' ro select a NEW batch number,",XH(1)="or '^' to exit."
82 . . . S %=$$YN^GECSUTIL(2) I %'=1 Q
83 . . . S GECSBATC=$P(^GECS(2100,GECS("CSDA"),"TRANS"),"^",9)
84 . . . S %=$$MARKBAT(GECS("CSDA"))
85 . . . D KILLBATC(GECSBATC)
86 . . . S %=0
87 . . S GECSDICS="I $P(^(0),U,6)=GECS(""BATDA""),$P(^(0),U,4)="""""
88 . . S GECSBATC=$$BATCHSEL^GECSUSEL(GECSDICS) I 'GECSBATC Q
89 . . S GECSBATC=$P($G(^GECS(2101.3,GECSBATC,0)),"^") I GECSBATC="" Q
90 . . S XP="READY TO CHANGE THE BATCH NUMBER",XH="Enter 'YES' to change the batch number, 'NO' or '^' to exit."
91 . . I $$YN^GECSUTIL(1)'=1 Q
92 . . D SETBATCH(GECS("CSDA"),GECSBATC)
93 . D ERROR^GECSUTIL(GECSDA)
94 Q
95 ;
96SETBATCH(DA,GECSBATC) ; set code sheet da to gecsbatc batch
97 N DIC,DIE,DR,X,Y
98 S (DIC,DIE)="^GECS(2100,",DR=".1///@;.15///Y;.8////"_GECSBATC_";.9//3;"
99 D ^DIE I $D(Y) W !,"UNABLE TO SET BATCH NUMBER ",GECSBATC Q
100 W !,"CODE SHEET READY FOR TRANSMISSION IN BATCH ",GECSBATC
101 Q
102 ;
103KILLBATC(GECSBATC) ; check if any code sheets are in batch, if no delete it
104 I '$L(GECSBATC) Q
105 I $D(^GECS(2100,"AB",GECSBATC)) Q
106 N DA
107 S DA=+$O(^GECS(2101.3,"B",GECSBATC,0)) I 'DA Q
108 W !!,"NO CODE SHEETS INCLUDED IN BATCH ",GECSBATC,".",!,"DELETING BATCH ",GECSBATC
109 D KILLBATC^GECSPUR1(DA)
110 Q
Note: See TracBrowser for help on using the repository browser.