GECSUSTA ;WISC/RFJ/KLD-code sheet status utilities ;01 Nov 93
;;2.0;GCS;**15**;MAR 14, 1995
Q
;
;
RETAIN(DA) ; retain code sheet da in file
; take out all batching and transmission parameters
I '$D(^GECS(2100,DA)) Q
N %,D,D0,DI,DIC,DIE,DQ,DR,X,Y
S (DIC,DIE)="^GECS(2100,",DR=".1///@;.15///@;.6///@;.8///@;.85///@;.95///@;" D ^DIE
K ^GECS(2100,DA,"TRANS")
Q
;
;
STATUS(DA) ; show status of code sheet da
; 0=retained in file
N %,X,Y
W !?1,"Status: << "
I '$D(^GECS(2100,DA,"TRANS")) W "RETAINED IN FILE >>" Q 0
; 1=ready for batching
S %=^GECS(2100,DA,"TRANS")
I $P(%,"^")="Y" D Q 1
. S X=$P(%,"^",7) W "READY FOR BATCHING [Priority: ",$P(%,"^",10),", Trans Date: ",$E(X,4,5),"-",$E(X,6,7),"-"
. S Y=X D DD^%DT W $E($P(Y,",",2),2,5),"] >>"
; 2=ready for transmission
I $P(%,"^",2)="Y" D Q 2
. S X=$P(%,"^",7) W "READY FOR TRANSMISSION IN BATCH ",$P(%,"^",9)," [Date:",$E(X,4,5),"-",$E(X,6,7),"-"
. S Y=X D DD^%DT W $E($P(Y,",",2),2,5),"] >>"
; 3=transmitted (regular code sheet)
I $P(%,"^",9)'="" D Q 3
. S X=$P($G(^GECS(2101.3,+$O(^GECS(2101.3,"B",$P(%,"^",9),0)),0)),"^",4) W "TRANSMITTED IN BATCH ",$P(%,"^",9)
. I X'="" D
. . W " ",$E(X,4,5)_"-"_$E(X,6,7)_"-"
. . S Y=X D DD^%DT W $E($P(Y,",",2),2,5)," <<"
; 3=transmitted (fms code sheet)
I $P($G(^GECS(2100,DA,0)),"^",2)="FMS",$P(%,"^",3)'="" W "TRANSMITTED IN STACK: ",$P(%,"^",3)," <<" Q 3
W "RETAINED IN FILE >>" Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGECSUSTA 1485 printed Nov 22, 2024@17:06:46 Page 2
GECSUSTA ;WISC/RFJ/KLD-code sheet status utilities ;01 Nov 93
+1 ;;2.0;GCS;**15**;MAR 14, 1995
+2 QUIT
+3 ;
+4 ;
RETAIN(DA) ; retain code sheet da in file
+1 ; take out all batching and transmission parameters
+2 IF '$DATA(^GECS(2100,DA))
QUIT
+3 NEW %,D,D0,DI,DIC,DIE,DQ,DR,X,Y
+4 SET (DIC,DIE)="^GECS(2100,"
SET DR=".1///@;.15///@;.6///@;.8///@;.85///@;.95///@;"
DO ^DIE
+5 KILL ^GECS(2100,DA,"TRANS")
+6 QUIT
+7 ;
+8 ;
STATUS(DA) ; show status of code sheet da
+1 ; 0=retained in file
+2 NEW %,X,Y
+3 WRITE !?1,"Status: << "
+4 IF '$DATA(^GECS(2100,DA,"TRANS"))
WRITE "RETAINED IN FILE >>"
QUIT 0
+5 ; 1=ready for batching
+6 SET %=^GECS(2100,DA,"TRANS")
+7 IF $PIECE(%,"^")="Y"
Begin DoDot:1
+8 SET X=$PIECE(%,"^",7)
WRITE "READY FOR BATCHING [Priority: ",$PIECE(%,"^",10),", Trans Date: ",$EXTRACT(X,4,5),"-",$EXTRACT(X,6,7),"-"
+9 SET Y=X
DO DD^%DT
WRITE $EXTRACT($PIECE(Y,",",2),2,5),"] >>"
End DoDot:1
QUIT 1
+10 ; 2=ready for transmission
+11 IF $PIECE(%,"^",2)="Y"
Begin DoDot:1
+12 SET X=$PIECE(%,"^",7)
WRITE "READY FOR TRANSMISSION IN BATCH ",$PIECE(%,"^",9)," [Date:",$EXTRACT(X,4,5),"-",$EXTRACT(X,6,7),"-"
+13 SET Y=X
DO DD^%DT
WRITE $EXTRACT($PIECE(Y,",",2),2,5),"] >>"
End DoDot:1
QUIT 2
+14 ; 3=transmitted (regular code sheet)
+15 IF $PIECE(%,"^",9)'=""
Begin DoDot:1
+16 SET X=$PIECE($GET(^GECS(2101.3,+$ORDER(^GECS(2101.3,"B",$PIECE(%,"^",9),0)),0)),"^",4)
WRITE "TRANSMITTED IN BATCH ",$PIECE(%,"^",9)
+17 IF X'=""
Begin DoDot:2
+18 WRITE " ",$EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,7)_"-"
+19 SET Y=X
DO DD^%DT
WRITE $EXTRACT($PIECE(Y,",",2),2,5)," <<"
End DoDot:2
End DoDot:1
QUIT 3
+20 ; 3=transmitted (fms code sheet)
+21 IF $PIECE($GET(^GECS(2100,DA,0)),"^",2)="FMS"
IF $PIECE(%,"^",3)'=""
WRITE "TRANSMITTED IN STACK: ",$PIECE(%,"^",3)," <<"
QUIT 3
+22 WRITE "RETAINED IN FILE >>"
QUIT 0
