GECSUTIL ;WISC/RFJ/KLD-code sheet utilities ;13 Oct 98
;;2.0;GCS;**1,19**;MAR 14, 1995
Q
;
;
DELASK(GECSDA) ; ask to delete the code sheet gecsda
N %,GECSBATC
S XP="ARE YOU SURE YOU WANT TO DELETE THE CODE SHEET",XH="Enter 'YES' to delete."
W ! I $$YN(2)'=1 S %=$$STATUS^GECSUSTA(GECSDA) Q
S GECSBATC=$P($G(^GECS(2100,GECSDA,"TRANS")),"^",9)
D KILLCS^GECSPUR1(GECSDA) W " << CODE SHEET DELETED >>"
I $L(GECSBATC) D KILLBATC^GECSMUT1(GECSBATC)
Q
;
;
PRINTDQ ; taskman comes here to print code sheet gecsda
D PRINT(GECSDA)
Q
;
;
PRINT(GECSDA) ; print code sheet gecsda
N %,D,DA1,GECSFLAG,LINE
I '$D(IO) S IOP="HOME" D ^%ZIS K IOP
W !!,"TRANSMITTED CODE SHEET FOR ID# ",$P(^GECS(2100,GECSDA,0),"^")," WILL BE AS FOLLOWS:",!
F %=1:1:79 W $S(%#10=0:$E(%),%#5=0:"+",1:".")
S LINE=1,DA1=0 F S DA1=$O(^GECS(2100,GECSDA,"CODE",DA1)) Q:'DA1!($G(GECSFLAG)) S D=$G(^(DA1,0)) I D'="" D
. I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C",LINE=20 D Q:$G(GECSFLAG)
. . S LINE=1
. . D PAUSE Q:$G(GECSFLAG)
. . W !! F %=1:1:79 W $S(%#10=0:$E(%),%#5=0:"+",1:".")
. W !,D
. S LINE=LINE+1
W !
I LINE>13 D R
Q
;
;
VARIABLE(GECSDA) ; set up variables for code sheet gecsda
N D,GECSFLAG,GECSFNOP
K GECS
S D=$G(^GECS(2100,+GECSDA,0)) I D="" W !,"CODE SHEET MISSING" Q
S GECS("CSDA")=+GECSDA
S GECS("CSNAME")=$P(D,"^")
S GECS("SYSID")=$P(D,"^",2)
S GECS("BATDA")=+$P(D,"^",3)
S GECS("BATCH")=$P($G(^GECS(2101.1,GECS("BATDA"),0)),"^")
S GECS("SITE")=$P(D,"^",6)
S GECS("SITE1")=$P(D,"^",7)
S GECS("TT")=$P(D,"^",8) S:GECS("TT")="" GECS("TT")=" "
S GECS("TTDA")=+$O(^GECS(2101.2,"B",GECS("TT"),0))
S GECS("EDIT")=$P(D,"^",11) S:GECS("EDIT")="" GECS("EDIT")="[ ]"
S GECS("TRANSFMS")=$P($G(^GECS(2100,+GECSDA,"TRANS")),"^",3)
I GECS("TRANSFMS")'="" D
. S GECS("TRANSFMSDA")=$O(^GECS(2100.1,"B",GECS("TRANSFMS"),""))
; check variables
I GECS("CSNAME")="" W !,"CODE SHEET NAME MISSING" S GECSFLAG=1
I GECS("SYSID")="" W !,"SYSTEM IDENTIFIER MISSING" S GECSFLAG=1
I GECS("BATCH")="" W !,"BATCH TYPE MISSING" S GECSFLAG=1
I 'GECS("SITE") W !,"STATION NUMBER MISSING" S GECSFLAG=1
I 'GECS("TTDA") W !,"TRANSACTION TYPE/SEGMENT MISSING" S GECSFLAG=1
I '$O(^DIE("B",$E(GECS("EDIT"),2,$L(GECS("EDIT"))-1),0)) W !,"EDIT TEMPLATE MISSING" S GECSFLAG=1
I GECS("SITE") S GECSFNOP=1 D GETSITE^GECSSITE($O(^DIC(4,"D",GECS("SITE")_GECS("SITE1"),0))) I '$D(GECS("SITE")) S GECSFLAG=1
I $G(GECSFLAG) K GECS
Q
;
;
ERROR(GECSDA) ; error in code sheet variables
W !!,"SINCE THERE ARE DATA ERRORS FOR THIS CODE SHEET, IT CANNOT BE EDITTED.",!,"THIS CODE SHEET SHOULD BE DELETED AND RE-ENTERED AS A NEW CODE SHEET."
D DELASK^GECSUTIL(GECSDA)
Q
;
;
R ; press return to continue
N X U IO(0) W !,"<Press RETURN to continue>" R X:DTIME Q
;
;
PAUSE ; pause
N X U IO(0) W !,"Press RETURN to continue, '^' to exit:" R X:DTIME S:'$T X="^" S:X["^" GECSFLAG=1 U IO Q
;
;
YN(%) ; yes, no reader
; %=default answer [1=yes,2=no];
; XP=prompt array [none,1,2,3...];
; XH=help array [none,1,2,3...]
N I,X
I '$G(%) S %=3
F D Q:$D(X)
. W:$D(XP) !,XP F I=1:1 Q:'$D(XP(I)) W !,XP(I)
. W "? ",$P("YES// ^NO// ^<YES/NO> ","^",%)
. R X:$S($D(DTIME):DTIME,1:300) E W " <<timeout>>" S X=0 Q
. I X["^" S X=0 Q
. S:X="" X=% S X=$TR($E(X),"yYnN","1122"),X=+X
. I X'=1,X'=2 D HELP K X Q
. W:$X>73 ! W $P(" (YES)^ (NO)","^",X)
K XH,XP
Q X
;
HELP I '$D(XH) W !,"You must enter a 'Yes' or a 'No', or you may enter an '^' to Quit",!! Q
W !,XH F I=1:1 Q:'$D(XH(I)) W !,XH(I)
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGECSUTIL 3663 printed Nov 22, 2024@17:06:47 Page 2
GECSUTIL ;WISC/RFJ/KLD-code sheet utilities ;13 Oct 98
+1 ;;2.0;GCS;**1,19**;MAR 14, 1995
+2 QUIT
+3 ;
+4 ;
DELASK(GECSDA) ; ask to delete the code sheet gecsda
+1 NEW %,GECSBATC
+2 SET XP="ARE YOU SURE YOU WANT TO DELETE THE CODE SHEET"
SET XH="Enter 'YES' to delete."
+3 WRITE !
IF $$YN(2)'=1
SET %=$$STATUS^GECSUSTA(GECSDA)
QUIT
+4 SET GECSBATC=$PIECE($GET(^GECS(2100,GECSDA,"TRANS")),"^",9)
+5 DO KILLCS^GECSPUR1(GECSDA)
WRITE " << CODE SHEET DELETED >>"
+6 IF $LENGTH(GECSBATC)
DO KILLBATC^GECSMUT1(GECSBATC)
+7 QUIT
+8 ;
+9 ;
PRINTDQ ; taskman comes here to print code sheet gecsda
+1 DO PRINT(GECSDA)
+2 QUIT
+3 ;
+4 ;
PRINT(GECSDA) ; print code sheet gecsda
+1 NEW %,D,DA1,GECSFLAG,LINE
+2 IF '$DATA(IO)
SET IOP="HOME"
DO ^%ZIS
KILL IOP
+3 WRITE !!,"TRANSMITTED CODE SHEET FOR ID# ",$PIECE(^GECS(2100,GECSDA,0),"^")," WILL BE AS FOLLOWS:",!
+4 FOR %=1:1:79
WRITE $SELECT(%#10=0:$EXTRACT(%),%#5=0:"+",1:".")
+5 SET LINE=1
SET DA1=0
FOR
SET DA1=$ORDER(^GECS(2100,GECSDA,"CODE",DA1))
if 'DA1!($GET(GECSFLAG))
QUIT
SET D=$GET(^(DA1,0))
IF D'=""
Begin DoDot:1
+6 IF '$DATA(ZTQUEUED)
IF IO=IO(0)
IF $EXTRACT(IOST)="C"
IF LINE=20
Begin DoDot:2
+7 SET LINE=1
+8 DO PAUSE
if $GET(GECSFLAG)
QUIT
+9 WRITE !!
FOR %=1:1:79
WRITE $SELECT(%#10=0:$EXTRACT(%),%#5=0:"+",1:".")
End DoDot:2
if $GET(GECSFLAG)
QUIT
+10 WRITE !,D
+11 SET LINE=LINE+1
End DoDot:1
+12 WRITE !
+13 IF LINE>13
DO R
+14 QUIT
+15 ;
+16 ;
VARIABLE(GECSDA) ; set up variables for code sheet gecsda
+1 NEW D,GECSFLAG,GECSFNOP
+2 KILL GECS
+3 SET D=$GET(^GECS(2100,+GECSDA,0))
IF D=""
WRITE !,"CODE SHEET MISSING"
QUIT
+4 SET GECS("CSDA")=+GECSDA
+5 SET GECS("CSNAME")=$PIECE(D,"^")
+6 SET GECS("SYSID")=$PIECE(D,"^",2)
+7 SET GECS("BATDA")=+$PIECE(D,"^",3)
+8 SET GECS("BATCH")=$PIECE($GET(^GECS(2101.1,GECS("BATDA"),0)),"^")
+9 SET GECS("SITE")=$PIECE(D,"^",6)
+10 SET GECS("SITE1")=$PIECE(D,"^",7)
+11 SET GECS("TT")=$PIECE(D,"^",8)
if GECS("TT")=""
SET GECS("TT")=" "
+12 SET GECS("TTDA")=+$ORDER(^GECS(2101.2,"B",GECS("TT"),0))
+13 SET GECS("EDIT")=$PIECE(D,"^",11)
if GECS("EDIT")=""
SET GECS("EDIT")="[ ]"
+14 SET GECS("TRANSFMS")=$PIECE($GET(^GECS(2100,+GECSDA,"TRANS")),"^",3)
+15 IF GECS("TRANSFMS")'=""
Begin DoDot:1
+16 SET GECS("TRANSFMSDA")=$ORDER(^GECS(2100.1,"B",GECS("TRANSFMS"),""))
End DoDot:1
+17 ; check variables
+18 IF GECS("CSNAME")=""
WRITE !,"CODE SHEET NAME MISSING"
SET GECSFLAG=1
+19 IF GECS("SYSID")=""
WRITE !,"SYSTEM IDENTIFIER MISSING"
SET GECSFLAG=1
+20 IF GECS("BATCH")=""
WRITE !,"BATCH TYPE MISSING"
SET GECSFLAG=1
+21 IF 'GECS("SITE")
WRITE !,"STATION NUMBER MISSING"
SET GECSFLAG=1
+22 IF 'GECS("TTDA")
WRITE !,"TRANSACTION TYPE/SEGMENT MISSING"
SET GECSFLAG=1
+23 IF '$ORDER(^DIE("B",$EXTRACT(GECS("EDIT"),2,$LENGTH(GECS("EDIT"))-1),0))
WRITE !,"EDIT TEMPLATE MISSING"
SET GECSFLAG=1
+24 IF GECS("SITE")
SET GECSFNOP=1
DO GETSITE^GECSSITE($ORDER(^DIC(4,"D",GECS("SITE")_GECS("SITE1"),0)))
IF '$DATA(GECS("SITE"))
SET GECSFLAG=1
+25 IF $GET(GECSFLAG)
KILL GECS
+26 QUIT
+27 ;
+28 ;
ERROR(GECSDA) ; error in code sheet variables
+1 WRITE !!,"SINCE THERE ARE DATA ERRORS FOR THIS CODE SHEET, IT CANNOT BE EDITTED.",!,"THIS CODE SHEET SHOULD BE DELETED AND RE-ENTERED AS A NEW CODE SHEET."
+2 DO DELASK^GECSUTIL(GECSDA)
+3 QUIT
+4 ;
+5 ;
R ; press return to continue
+1 NEW X
USE IO(0)
WRITE !,"<Press RETURN to continue>"
READ X:DTIME
QUIT
+2 ;
+3 ;
PAUSE ; pause
+1 NEW X
USE IO(0)
WRITE !,"Press RETURN to continue, '^' to exit:"
READ X:DTIME
if '$TEST
SET X="^"
if X["^"
SET GECSFLAG=1
USE IO
QUIT
+2 ;
+3 ;
YN(%) ; yes, no reader
+1 ; %=default answer [1=yes,2=no];
+2 ; XP=prompt array [none,1,2,3...];
+3 ; XH=help array [none,1,2,3...]
+4 NEW I,X
+5 IF '$GET(%)
SET %=3
+6 FOR
Begin DoDot:1
+7 if $DATA(XP)
WRITE !,XP
FOR I=1:1
if '$DATA(XP(I))
QUIT
WRITE !,XP(I)
+8 WRITE "? ",$PIECE("YES// ^NO// ^<YES/NO> ","^",%)
+9 READ X:$SELECT($DATA(DTIME):DTIME,1:300)
IF '$TEST
WRITE " <<timeout>>"
SET X=0
QUIT
+10 IF X["^"
SET X=0
QUIT
+11 if X=""
SET X=%
SET X=$TRANSLATE($EXTRACT(X),"yYnN","1122")
SET X=+X
+12 IF X'=1
IF X'=2
DO HELP
KILL X
QUIT
+13 if $X>73
WRITE !
WRITE $PIECE(" (YES)^ (NO)","^",X)
End DoDot:1
if $DATA(X)
QUIT
+14 KILL XH,XP
+15 QUIT X
+16 ;
HELP IF '$DATA(XH)
WRITE !,"You must enter a 'Yes' or a 'No', or you may enter an '^' to Quit",!!
QUIT
+1 WRITE !,XH
FOR I=1:1
if '$DATA(XH(I))
QUIT
WRITE !,XH(I)
+2 WRITE !
+3 QUIT
