- 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 Apr 23, 2025@18:11:07 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
