GECSEDIT ;WISC/RFJ/KLD-create and edit code sheets ;13 Oct 98
;;2.0;GCS;**2,6,9,15,19,27**;MAR 14, 1995
;
N %,DONTASK,GECS,GECSFLAG,GECSFXIT
D ^GECSSITE Q:'$G(GECS("SITE"))
I $L($G(GECSSYS)) S DONTASK=1
W ! D BATTYPE^GECSUSEL($G(GECSSYS),$G(DONTASK)) Q:'$G(GECS("BATDA"))
F W ! D TRANTYPE^GECSUSEL($G(GECSSEGM),0) Q:$G(GECSFLAG) I $G(GECS("TTDA")) D
. I $D(GECSFKP) S GECS("EDIT")=GECSFKP
. D NEWCS I '$G(GECS("CSDA")) Q
. I GECS("SYSID")="AMS" D AMIS I '$G(GECS("CSDA")) Q
. S %=$$CSEDIT
. I %<0 D KILLCS^GECSPUR1(GECS("CSDA")) W " << CODE SHEET DELETED >>" Q
. I '%!($G(GECSFXIT)) D DELASK^GECSUTIL(GECS("CSDA")) I '$D(^GECS(2100,+$G(GECS("CSDA")),0)) Q
. I '$$MAPDATA^GECSXBLD(GECS("CSDA")) Q
. D ASKTOBAT^GECSXBL1(GECS("CSDA"))
Q
;
;
NEWCS ; get new code sheet number
; return gecs("csname"),gecs("csda")
N %,%DT,%Y,COUNTER,D0,DA,DI,DIC,DIE,DLAYGO,DQ,DR,GECSNAME,X,Y
K GECS("CSNAME"),GECS("CSDA")
F S COUNTER=$$COUNTER^GECSUNUM(GECS("SITE")_"-"_GECS("SYSID")_"-"_GECS("FY")) Q:'COUNTER D Q:COUNTER
. S X=COUNTER_"-"_GECS("FY")
. ; entry already in file 2100, get next counter
. I $D(^GECS(2100,"B",X)) S COUNTER=0 Q
. S DIC="^GECS(2100,",DIC(0)="LZ",DLAYGO=2100 D ^DIC K DLAYGO I Y'>0 S COUNTER=0 Q
. ; existing entry selected
. I '$P(Y,"^",3) S COUNTER=0 Q
I 'COUNTER Q
;
W !!,"This code sheet has been assigned IDENTIFICATION NUMBER: ",$P(Y(0),"^")
S GECSNAME=$P(Y(0),"^")
S DIE="^GECS(2100,",DA=+Y
S DR="1///"_GECS("SYSID")_";5///"_GECS("SITE")_";Q;6///"_GECS("SITE1")_";7///"_GECS("TT")_";9///NOW;9.01////"_$P(GECS("PER"),"^")_";10///"_GECS("EDIT")_";2///"_GECS("BATDA")
D ^DIE I $D(Y) W !,"UNABLE TO CREATE CODE SHEET!" Q
S GECS("CSDA")=DA,GECS("CSNAME")=GECSNAME
Q
;
;
CSEDIT() ; edit code sheet gecs(csda)
; return -1 if code sheet not edit (for fms docs)
; return 0 if ^ entered
N %,%X,%Y,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
K GECSFXIT
W !
S (DIC,DIE)="^GECS(2100,",DA=GECS("CSDA")
; edit control segment for fms
I GECS("SYSID")="FMS" S DR="[PRCFMS:CONTROL]" W !!?5,"-- FMS Control Segment Data --" D ^DIE I $D(Y) Q -1
S DR=GECS("EDIT")
I GECS("SYSID")="FMS" W !!?5,"-- FMS Document Data --"
I GECS("EDIT")["KEYPUNCH" W !?4 F %=1:1:75 W $S(%#10=0:$E(%),%#5=0:"+",1:".")
D ^DIE
I $D(Y) Q 0
Q 1
;
;
EDIT ; edit selected code sheet
N %,GECS,GECSDA,GECSFXIT,GECSSTAT,GECSBTYP,ABORT,DIR
D ^GECSSITE Q:'$D(GECS("SITE"))
W ! D BATTYPE^GECSUSEL($G(GECSSYS),$S($L($G(GECSSYS)):1,1:0)) Q:'$G(GECS("BATDA"))
S GECSBTYP=GECS("BATCH"),ABORT=0
F S GECSDA=$$CODESHET^GECSUSEL(GECSBTYP) Q:'GECSDA D
. D VARIABLE^GECSUTIL(GECSDA)
. Q:$G(SITEM)
. I $G(GECS("TRANSFMSDA"))'="" D Q:ABORT
. . I $$GET1^DIQ(2100.1,GECS("TRANSFMSDA"),3,"I")="F" D Q:ABORT
. . . W !!,"Current Status: Warning - "_$$GET1^DIQ(2100.1,GECS("TRANSFMSDA"),3,"E"),!
. . . S ABORT=1
. . . S DIR(0)="E",DIR("A")="Enter RETURN or '^' to exit"
. . . D ^DIR
. . . Q
. I $G(GECS("CSDA")) D Q
. . W ! S GECSSTAT=$$STATUS^GECSUSTA(GECS("CSDA")) W !
. . I GECS("SYSID")="AMS" D AMIS I '$G(GECS("CSDA")) Q
. . S %=$$CSEDIT
. . I %<0!($G(GECSFXIT))
. . I '$$MAPDATA^GECSXBLD(GECS("CSDA")) Q
. . I GECSSTAT=0 D ASKTOBAT^GECSXBL1(GECS("CSDA")) Q
. . I GECSSTAT=3,GECS("SYSID")="FMS" D ASKTOBAT^GECSXBL1(GECS("CSDA")) Q
. . I GECSSTAT=3,$$ASKREBAT^GECSMUT1 S %=$$MARKBAT^GECSMUT1(GECS("CSDA"))
. D ERROR^GECSUTIL(GECSDA)
Q
;
;
AMIS ; ask amis month-year if system id = AMS
N %,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
S (DIC,DIE)="^GECS(2100,",DA=GECS("CSDA"),DR=9.1 D ^DIE
I $D(Y) K GECS("CSDA")
Q
;
;
KEY ; keypunch a code sheet
; set variable gecsfkp=[input template]
N GECSFKP
S GECSFKP="[GECS KEYPUNCH]" D GECSEDIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGECSEDIT 3891 printed Dec 13, 2024@01:56:08 Page 2
GECSEDIT ;WISC/RFJ/KLD-create and edit code sheets ;13 Oct 98
+1 ;;2.0;GCS;**2,6,9,15,19,27**;MAR 14, 1995
+2 ;
+3 NEW %,DONTASK,GECS,GECSFLAG,GECSFXIT
+4 DO ^GECSSITE
if '$GET(GECS("SITE"))
QUIT
+5 IF $LENGTH($GET(GECSSYS))
SET DONTASK=1
+6 WRITE !
DO BATTYPE^GECSUSEL($GET(GECSSYS),$GET(DONTASK))
if '$GET(GECS("BATDA"))
QUIT
+7 FOR
WRITE !
DO TRANTYPE^GECSUSEL($GET(GECSSEGM),0)
if $GET(GECSFLAG)
QUIT
IF $GET(GECS("TTDA"))
Begin DoDot:1
+8 IF $DATA(GECSFKP)
SET GECS("EDIT")=GECSFKP
+9 DO NEWCS
IF '$GET(GECS("CSDA"))
QUIT
+10 IF GECS("SYSID")="AMS"
DO AMIS
IF '$GET(GECS("CSDA"))
QUIT
+11 SET %=$$CSEDIT
+12 IF %<0
DO KILLCS^GECSPUR1(GECS("CSDA"))
WRITE " << CODE SHEET DELETED >>"
QUIT
+13 IF '%!($GET(GECSFXIT))
DO DELASK^GECSUTIL(GECS("CSDA"))
IF '$DATA(^GECS(2100,+$GET(GECS("CSDA")),0))
QUIT
+14 IF '$$MAPDATA^GECSXBLD(GECS("CSDA"))
QUIT
+15 DO ASKTOBAT^GECSXBL1(GECS("CSDA"))
End DoDot:1
+16 QUIT
+17 ;
+18 ;
NEWCS ; get new code sheet number
+1 ; return gecs("csname"),gecs("csda")
+2 NEW %,%DT,%Y,COUNTER,D0,DA,DI,DIC,DIE,DLAYGO,DQ,DR,GECSNAME,X,Y
+3 KILL GECS("CSNAME"),GECS("CSDA")
+4 FOR
SET COUNTER=$$COUNTER^GECSUNUM(GECS("SITE")_"-"_GECS("SYSID")_"-"_GECS("FY"))
if 'COUNTER
QUIT
Begin DoDot:1
+5 SET X=COUNTER_"-"_GECS("FY")
+6 ; entry already in file 2100, get next counter
+7 IF $DATA(^GECS(2100,"B",X))
SET COUNTER=0
QUIT
+8 SET DIC="^GECS(2100,"
SET DIC(0)="LZ"
SET DLAYGO=2100
DO ^DIC
KILL DLAYGO
IF Y'>0
SET COUNTER=0
QUIT
+9 ; existing entry selected
+10 IF '$PIECE(Y,"^",3)
SET COUNTER=0
QUIT
End DoDot:1
if COUNTER
QUIT
+11 IF 'COUNTER
QUIT
+12 ;
+13 WRITE !!,"This code sheet has been assigned IDENTIFICATION NUMBER: ",$PIECE(Y(0),"^")
+14 SET GECSNAME=$PIECE(Y(0),"^")
+15 SET DIE="^GECS(2100,"
SET DA=+Y
+16 SET DR="1///"_GECS("SYSID")_";5///"_GECS("SITE")_";Q;6///"_GECS("SITE1")_";7///"_GECS("TT")_";9///NOW;9.01////"_$PIECE(GECS("PER"),"^")_";10///"_GECS("EDIT")_";2///"_GECS("BATDA")
+17 DO ^DIE
IF $DATA(Y)
WRITE !,"UNABLE TO CREATE CODE SHEET!"
QUIT
+18 SET GECS("CSDA")=DA
SET GECS("CSNAME")=GECSNAME
+19 QUIT
+20 ;
+21 ;
CSEDIT() ; edit code sheet gecs(csda)
+1 ; return -1 if code sheet not edit (for fms docs)
+2 ; return 0 if ^ entered
+3 NEW %,%X,%Y,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
+4 KILL GECSFXIT
+5 WRITE !
+6 SET (DIC,DIE)="^GECS(2100,"
SET DA=GECS("CSDA")
+7 ; edit control segment for fms
+8 IF GECS("SYSID")="FMS"
SET DR="[PRCFMS:CONTROL]"
WRITE !!?5,"-- FMS Control Segment Data --"
DO ^DIE
IF $DATA(Y)
QUIT -1
+9 SET DR=GECS("EDIT")
+10 IF GECS("SYSID")="FMS"
WRITE !!?5,"-- FMS Document Data --"
+11 IF GECS("EDIT")["KEYPUNCH"
WRITE !?4
FOR %=1:1:75
WRITE $SELECT(%#10=0:$EXTRACT(%),%#5=0:"+",1:".")
+12 DO ^DIE
+13 IF $DATA(Y)
QUIT 0
+14 QUIT 1
+15 ;
+16 ;
EDIT ; edit selected code sheet
+1 NEW %,GECS,GECSDA,GECSFXIT,GECSSTAT,GECSBTYP,ABORT,DIR
+2 DO ^GECSSITE
if '$DATA(GECS("SITE"))
QUIT
+3 WRITE !
DO BATTYPE^GECSUSEL($GET(GECSSYS),$SELECT($LENGTH($GET(GECSSYS)):1,1:0))
if '$GET(GECS("BATDA"))
QUIT
+4 SET GECSBTYP=GECS("BATCH")
SET ABORT=0
+5 FOR
SET GECSDA=$$CODESHET^GECSUSEL(GECSBTYP)
if 'GECSDA
QUIT
Begin DoDot:1
+6 DO VARIABLE^GECSUTIL(GECSDA)
+7 if $GET(SITEM)
QUIT
+8 IF $GET(GECS("TRANSFMSDA"))'=""
Begin DoDot:2
+9 IF $$GET1^DIQ(2100.1,GECS("TRANSFMSDA"),3,"I")="F"
Begin DoDot:3
+10 WRITE !!,"Current Status: Warning - "_$$GET1^DIQ(2100.1,GECS("TRANSFMSDA"),3,"E"),!
+11 SET ABORT=1
+12 SET DIR(0)="E"
SET DIR("A")="Enter RETURN or '^' to exit"
+13 DO ^DIR
+14 QUIT
End DoDot:3
if ABORT
QUIT
End DoDot:2
if ABORT
QUIT
+15 IF $GET(GECS("CSDA"))
Begin DoDot:2
+16 WRITE !
SET GECSSTAT=$$STATUS^GECSUSTA(GECS("CSDA"))
WRITE !
+17 IF GECS("SYSID")="AMS"
DO AMIS
IF '$GET(GECS("CSDA"))
QUIT
+18 SET %=$$CSEDIT
+19 IF %<0!($GET(GECSFXIT))
+20 IF '$$MAPDATA^GECSXBLD(GECS("CSDA"))
QUIT
+21 IF GECSSTAT=0
DO ASKTOBAT^GECSXBL1(GECS("CSDA"))
QUIT
+22 IF GECSSTAT=3
IF GECS("SYSID")="FMS"
DO ASKTOBAT^GECSXBL1(GECS("CSDA"))
QUIT
+23 IF GECSSTAT=3
IF $$ASKREBAT^GECSMUT1
SET %=$$MARKBAT^GECSMUT1(GECS("CSDA"))
End DoDot:2
QUIT
+24 DO ERROR^GECSUTIL(GECSDA)
End DoDot:1
+25 QUIT
+26 ;
+27 ;
AMIS ; ask amis month-year if system id = AMS
+1 NEW %,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
+2 SET (DIC,DIE)="^GECS(2100,"
SET DA=GECS("CSDA")
SET DR=9.1
DO ^DIE
+3 IF $DATA(Y)
KILL GECS("CSDA")
+4 QUIT
+5 ;
+6 ;
KEY ; keypunch a code sheet
+1 ; set variable gecsfkp=[input template]
+2 NEW GECSFKP
+3 SET GECSFKP="[GECS KEYPUNCH]"
DO GECSEDIT
+4 QUIT
