source: WorldVistAEHR/trunk/r/GENERIC_CODE_SHEET-GEC/GEC29TR.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: 1.5 KB
RevLine 
[613]1GEC29TR ;WIOFO/BGJ-POST INIT FOR GEC*2*29 ;03/05/02
2 ;;2.0;GCS;**29**;Mar 14, 1995
3 ;
4 ;This routine is called as a post init in patch GEC*2*29.
5 ;It creates the entry "TR:FMS" in file 2101.2.
6 ;It also requeues any "TR" document in file 2100.1 to FMS
7 ;that does not have a status of Accepted or Transmitted.
8 ;
9 Q
10 ;
11START N ABORT,GECDA,GECDOCID,GECER,GECSEG,GECSTAT,FDA
12 ;
13CREATE ;Create the TR:FMS entry in 2101.2.
14 S ABORT=0
15 S GECSEG="TR:FMS"
16 W:$G(IOF)'="" @IOF
17 W !,"Creating entry TR:FMS in file 2101.2..."
18 I $D(^GECS(2101.2,"B",GECSEG)) D Q
19 . W !!,"Entry TR:FMS already exists in file 2101.2",!
20 S FDA(2101.2,"?+1,",.01)=GECSEG
21 S FDA(2101.2,"?+1,",.7)="FINANCIAL MANAGEMENT"
22 S FDA(2101.2,"?+1,",1)="Y"
23 S FDA(2101.2,"?+1,",2)="FMS Transfer Document"
24 D UPDATE^DIE("E","FDA",,"GECER")
25 I $D(GECER) D Q:ABORT
26 . S ABORT=1
27 . W $C(7)
28 . W:$G(IOF)'="" @IOF
29 . W !!,"An ERROR has occured",!
30 . W $P(GECER("DIERR",1),"^")," - "
31 . W $P(GECER("DIERR",1,"TEXT",1),"^")
32 W !!,"Entry TR:FMS created in file 2101.2"
33 ;
34REQUEUE ;Requeue "TR" entries in 2100.1 that do not have a status
35 ;of "A" or "T".
36 W !!!,"Requeueing entries in file 2100.1...",!
37 S GECDOCID=""
38 F S GECDOCID=$O(^GECS(2100.1,"B",GECDOCID)) Q:GECDOCID="" D
39 . Q:$P(GECDOCID,"-")'="TR"
40 . S GECDA=0
41 . F S GECDA=$O(^GECS(2100.1,"B",GECDOCID,GECDA)) Q:GECDA="" D
42 . . Q:'($D(^GECS(2100.1,GECDA,0))#10)
43 . . S GECSTAT=$P(^GECS(2100.1,GECDA,0),"^",4)
44 . . Q:GECSTAT="T"!(GECSTAT="A")
45 . . D SETSTAT^GECSSTAA(GECDA,"Q")
46 . . W !,$P(^GECS(2100.1,GECDA,0),"^")," ","Queued"
47 W !!,"Done",!
48 Q
Note: See TracBrowser for help on using the repository browser.