source: WorldVistAEHR/trunk/r/GENERIC_CODE_SHEET-GEC/GECSUSTA.m@ 1710

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

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1GECSUSTA ;WISC/RFJ/KLD-code sheet status utilities ;01 Nov 93
2 ;;2.0;GCS;**15**;MAR 14, 1995
3 Q
4 ;
5 ;
6RETAIN(DA) ; retain code sheet da in file
7 ; take out all batching and transmission parameters
8 I '$D(^GECS(2100,DA)) Q
9 N %,D,D0,DI,DIC,DIE,DQ,DR,X,Y
10 S (DIC,DIE)="^GECS(2100,",DR=".1///@;.15///@;.6///@;.8///@;.85///@;.95///@;" D ^DIE
11 K ^GECS(2100,DA,"TRANS")
12 Q
13 ;
14 ;
15STATUS(DA) ; show status of code sheet da
16 ; 0=retained in file
17 N %,X,Y
18 W !?1,"Status: << "
19 I '$D(^GECS(2100,DA,"TRANS")) W "RETAINED IN FILE >>" Q 0
20 ; 1=ready for batching
21 S %=^GECS(2100,DA,"TRANS")
22 I $P(%,"^")="Y" D Q 1
23 . S X=$P(%,"^",7) W "READY FOR BATCHING [Priority: ",$P(%,"^",10),", Trans Date: ",$E(X,4,5),"-",$E(X,6,7),"-"
24 . S Y=X D DD^%DT W $E($P(Y,",",2),2,5),"] >>"
25 ; 2=ready for transmission
26 I $P(%,"^",2)="Y" D Q 2
27 . S X=$P(%,"^",7) W "READY FOR TRANSMISSION IN BATCH ",$P(%,"^",9)," [Date:",$E(X,4,5),"-",$E(X,6,7),"-"
28 . S Y=X D DD^%DT W $E($P(Y,",",2),2,5),"] >>"
29 ; 3=transmitted (regular code sheet)
30 I $P(%,"^",9)'="" D Q 3
31 . S X=$P($G(^GECS(2101.3,+$O(^GECS(2101.3,"B",$P(%,"^",9),0)),0)),"^",4) W "TRANSMITTED IN BATCH ",$P(%,"^",9)
32 . I X'="" D
33 . . W " ",$E(X,4,5)_"-"_$E(X,6,7)_"-"
34 . . S Y=X D DD^%DT W $E($P(Y,",",2),2,5)," <<"
35 ; 3=transmitted (fms code sheet)
36 I $P($G(^GECS(2100,DA,0)),"^",2)="FMS",$P(%,"^",3)'="" W "TRANSMITTED IN STACK: ",$P(%,"^",3)," <<" Q 3
37 W "RETAINED IN FILE >>" Q 0
Note: See TracBrowser for help on using the repository browser.