GECSVFY1 ;WISC/RFJ-verify and check code sheet parameters (check) ;18 Nov 93
;;2.0;GCS;;MAR 14, 1995
Q
;
;
CHECK ; check batch type
N %,GECSDA,GECSDA1,GECSD1,GECSDIE,GECSDOM,X
S %="",$P(%,"-",80)=""
W !,%,!,"checking batch type: ",$P(GECSD,";")
S GECSFLAG=0,GECSERR=1
S GECSDA=+$O(^GECS(2101.1,"B",$P(GECSD,";"),0)),GECSD1=$G(^GECS(2101.1,GECSDA,0))
; batch type not in file, add it
I GECSD1="" D Q:GECSFLAG
. W !?5,$J(GECSERR,2),". ERROR -- BATCH TYPE NOT FOUND IN FILE 2101.1" I 'GECSFIX S GECSFLAG=1 Q
. N D0,DA,DD,DI,DIC,DIE,DQ,DR,DLAYGO,X,Y
. S DIC="^GECS(2101.1,",DIC(0)="L",DLAYGO=2101.1,X=$P(GECSD,";"),DIC("DR")="2///"_$P(GECSD,";",2)_";3///"_$P(GECSD,";",3) D FILE^DICN
. I Y<1 S GECSFLAG=1 W !?10,"*** UNABLE TO ADD BATCH TYPE TO FILE 2101.1." Q
. S GECSDA=+Y,GECSD1=^GECS(2101.1,GECSDA,0) W !?10,"... BATCH TYPE ADDED TO FILE 2101.1."
;
S GECSDIE=""
I $P(GECSD,";",2)'=$P(GECSD1,"^",3) D
. W !?5,$J(GECSERR,2),". ERROR -- MAX CODE SHEETS PER MESSAGE SHOULD EQUAL '",$P(GECSD,";",2),"' [NOT '",$P(GECSD1,"^",3),"']" S GECSERR=GECSERR+1
. I GECSFIX S GECSDIE=$P(GECSD,";",2) W !?10,"... FIXING MAX CODE SHEETS PER MESSAGE."
I $P(GECSD,";",3)'=$P(GECSD1,"^",4) D
. W !?5,$J(GECSERR,2),". ERROR -- SYSTEM ID SHOULD EQUAL '",$P(GECSD,";",3),"' [NOT '",$P(GECSD1,"^",4),"']" S GECSERR=GECSERR+1
. I GECSFIX S $P(GECSDIE,"^",2)=$P(GECSD,";",3) W !?10,"... FIXING SYSTEM ID."
I GECSFIX,GECSDIE'="" D
. N D,D0,DA,DI,DIC,DIE,DQ,DR,X
. S DR="" I $P(GECSDIE,"^")'="" S DR="2///"_$P(GECSDIE,"^")_";"
. I $P(GECSDIE,"^",2)'="" S DR=DR_"3///"_$P(GECSDIE,"^",2)
. S (DIC,DIE)="^GECS(2101.1,",DA=GECSDA D ^DIE
;
I '$D(^GECS(2101.1,GECSDA,2,0)) S ^(0)="^2101.12^^"
S GECSDIE="",GECSDA1=+$O(^GECS(2101.1,GECSDA,2,"B","XXX",0)),GECSD1=$G(^GECS(2101.1,GECSDA,2,GECSDA1,0))
I GECSD1="" D Q:GECSFLAG
. W !?5,$J(GECSERR,2),". ERROR -- RECEIVING USER SHOULD EQUAL 'XXX'" S GECSERR=GECSERR+1
. I 'GECSFIX S GECSFLAG=1 Q
. N D0,DA,DD,DI,DIC,DIE,DQ,DR,DLAYGO,X,Y
. S (DA,DA(1))=GECSDA,DIC="^GECS(2101.1,"_DA_",2,",DIC(0)="L",DLAYGO=2101.1,X="XXX",DIC("DR")="2///Y" D FILE^DICN
. I Y<1 S GECSFLAG=1 W !?10,"*** UNABLE TO ADD RECEIVING USER 'XXX'." Q
. S GECSDA1=+Y,GECSD1=^GECS(2101.1,GECSDA,2,GECSDA1,0) W !?10,"... RECEIVING USER 'XXX' ADDED."
;
; check to make sure domain is in domain file
S X=$P(GECSD,";",4),X=$O(^DIC(4.2,"B",X,0))
I X="" D Q:GECSFLAG
. W !?5,$J(GECSERR,2),". ERROR -- DOMAIN '",$P(GECSD,";",4),"' NOT FOUND IN DOMAIN FILE." S GECSERR=GECSERR+1
. I 'GECSFIX S GECSFLAG=1 Q
. N D0,DA,DD,DI,DIC,DIE,DQ,DR,DLAYGO,X,Y
. S DIC="^DIC(4.2,",DIC(0)="L",DLAYGO=4.2,X=$P(GECSD,";",4),DIC("DR")="1///S;2///FOC-AUSTIN.DOMAIN.EXT" D FILE^DICN
. I Y<1 W !?10,"*** UNABLE TO ADD DOMAIN TO DOMAIN FILE." S GECSFLAG=1 Q
. W !?10,"... DOMAIN ADDED TO DOMAIN FILE."
;
S GECSDOM=$P($G(^DIC(4.2,+$P(GECSD1,"^",2),0)),"^")
I $P(GECSD,";",4)'=GECSDOM D
. W !?5,$J(GECSERR,2),". ERROR -- DOMAIN MAIL ROUTER SHOULD EQUAL '",$P(GECSD,";",4),"' " W:$L(GECSDOM)>5 !?46 W "[NOT '",GECSDOM,"']" S GECSERR=GECSERR+1
. I GECSFIX S $P(GECSDIE,"^")=$P(GECSD,";",4) W !?10,"... FIXING DOMAIN MAIL ROUTER."
I $P(GECSD1,"^",3)'=1 D
. W !?5,$J(GECSERR,2),". ERROR -- TRANSMIT SHOULD BE 'YES' [NOT 'NO']" S GECSERR=GECSERR+1
. I GECSFIX S $P(GECSDIE,"^",2)="Y" W !?10,"... FIXING TRANSMIT (TO YES)."
I GECSFIX,GECSDIE'="" D
. N D,D0,DA,DI,DIC,DIE,DQ,DR,X
. S DR="" I $P(GECSDIE,"^")'="" S DR="1///"_$P(GECSD,";",4)_";"
. I $P(GECSDIE,"^",2)'="" S DR=DR_"2///1"
. S (DIE,DIC)="^GECS(2101.1,"_GECSDA_",2,",DA(1)=GECSDA,DA=GECSDA1 D ^DIE
;
S X=$P($P($P(GECSD,";",4),"-",2),".",1)
I X="" W !?5,$J(GECSERR,2),". ERROR -- NO MAIL GROUP DEFINED." S GECSERR=GECSERR+1 Q
S DIC="^XMB(3.8,",DIC(0)="X" D ^DIC I Y<0 W !?5,$J(GECSERR,2),". ERROR -- THE MAIL GROUP '",X,"' NEEDS TO BE SET UP." S GECSERR=GECSERR+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGECSVFY1 3987 printed Dec 13, 2024@01:56:42 Page 2
GECSVFY1 ;WISC/RFJ-verify and check code sheet parameters (check) ;18 Nov 93
+1 ;;2.0;GCS;;MAR 14, 1995
+2 QUIT
+3 ;
+4 ;
CHECK ; check batch type
+1 NEW %,GECSDA,GECSDA1,GECSD1,GECSDIE,GECSDOM,X
+2 SET %=""
SET $PIECE(%,"-",80)=""
+3 WRITE !,%,!,"checking batch type: ",$PIECE(GECSD,";")
+4 SET GECSFLAG=0
SET GECSERR=1
+5 SET GECSDA=+$ORDER(^GECS(2101.1,"B",$PIECE(GECSD,";"),0))
SET GECSD1=$GET(^GECS(2101.1,GECSDA,0))
+6 ; batch type not in file, add it
+7 IF GECSD1=""
Begin DoDot:1
+8 WRITE !?5,$JUSTIFY(GECSERR,2),". ERROR -- BATCH TYPE NOT FOUND IN FILE 2101.1"
IF 'GECSFIX
SET GECSFLAG=1
QUIT
+9 NEW D0,DA,DD,DI,DIC,DIE,DQ,DR,DLAYGO,X,Y
+10 SET DIC="^GECS(2101.1,"
SET DIC(0)="L"
SET DLAYGO=2101.1
SET X=$PIECE(GECSD,";")
SET DIC("DR")="2///"_$PIECE(GECSD,";",2)_";3///"_$PIECE(GECSD,";",3)
DO FILE^DICN
+11 IF Y<1
SET GECSFLAG=1
WRITE !?10,"*** UNABLE TO ADD BATCH TYPE TO FILE 2101.1."
QUIT
+12 SET GECSDA=+Y
SET GECSD1=^GECS(2101.1,GECSDA,0)
WRITE !?10,"... BATCH TYPE ADDED TO FILE 2101.1."
End DoDot:1
if GECSFLAG
QUIT
+13 ;
+14 SET GECSDIE=""
+15 IF $PIECE(GECSD,";",2)'=$PIECE(GECSD1,"^",3)
Begin DoDot:1
+16 WRITE !?5,$JUSTIFY(GECSERR,2),". ERROR -- MAX CODE SHEETS PER MESSAGE SHOULD EQUAL '",$PIECE(GECSD,";",2),"' [NOT '",$PIECE(GECSD1,"^",3),"']"
SET GECSERR=GECSERR+1
+17 IF GECSFIX
SET GECSDIE=$PIECE(GECSD,";",2)
WRITE !?10,"... FIXING MAX CODE SHEETS PER MESSAGE."
End DoDot:1
+18 IF $PIECE(GECSD,";",3)'=$PIECE(GECSD1,"^",4)
Begin DoDot:1
+19 WRITE !?5,$JUSTIFY(GECSERR,2),". ERROR -- SYSTEM ID SHOULD EQUAL '",$PIECE(GECSD,";",3),"' [NOT '",$PIECE(GECSD1,"^",4),"']"
SET GECSERR=GECSERR+1
+20 IF GECSFIX
SET $PIECE(GECSDIE,"^",2)=$PIECE(GECSD,";",3)
WRITE !?10,"... FIXING SYSTEM ID."
End DoDot:1
+21 IF GECSFIX
IF GECSDIE'=""
Begin DoDot:1
+22 NEW D,D0,DA,DI,DIC,DIE,DQ,DR,X
+23 SET DR=""
IF $PIECE(GECSDIE,"^")'=""
SET DR="2///"_$PIECE(GECSDIE,"^")_";"
+24 IF $PIECE(GECSDIE,"^",2)'=""
SET DR=DR_"3///"_$PIECE(GECSDIE,"^",2)
+25 SET (DIC,DIE)="^GECS(2101.1,"
SET DA=GECSDA
DO ^DIE
End DoDot:1
+26 ;
+27 IF '$DATA(^GECS(2101.1,GECSDA,2,0))
SET ^(0)="^2101.12^^"
+28 SET GECSDIE=""
SET GECSDA1=+$ORDER(^GECS(2101.1,GECSDA,2,"B","XXX",0))
SET GECSD1=$GET(^GECS(2101.1,GECSDA,2,GECSDA1,0))
+29 IF GECSD1=""
Begin DoDot:1
+30 WRITE !?5,$JUSTIFY(GECSERR,2),". ERROR -- RECEIVING USER SHOULD EQUAL 'XXX'"
SET GECSERR=GECSERR+1
+31 IF 'GECSFIX
SET GECSFLAG=1
QUIT
+32 NEW D0,DA,DD,DI,DIC,DIE,DQ,DR,DLAYGO,X,Y
+33 SET (DA,DA(1))=GECSDA
SET DIC="^GECS(2101.1,"_DA_",2,"
SET DIC(0)="L"
SET DLAYGO=2101.1
SET X="XXX"
SET DIC("DR")="2///Y"
DO FILE^DICN
+34 IF Y<1
SET GECSFLAG=1
WRITE !?10,"*** UNABLE TO ADD RECEIVING USER 'XXX'."
QUIT
+35 SET GECSDA1=+Y
SET GECSD1=^GECS(2101.1,GECSDA,2,GECSDA1,0)
WRITE !?10,"... RECEIVING USER 'XXX' ADDED."
End DoDot:1
if GECSFLAG
QUIT
+36 ;
+37 ; check to make sure domain is in domain file
+38 SET X=$PIECE(GECSD,";",4)
SET X=$ORDER(^DIC(4.2,"B",X,0))
+39 IF X=""
Begin DoDot:1
+40 WRITE !?5,$JUSTIFY(GECSERR,2),". ERROR -- DOMAIN '",$PIECE(GECSD,";",4),"' NOT FOUND IN DOMAIN FILE."
SET GECSERR=GECSERR+1
+41 IF 'GECSFIX
SET GECSFLAG=1
QUIT
+42 NEW D0,DA,DD,DI,DIC,DIE,DQ,DR,DLAYGO,X,Y
+43 SET DIC="^DIC(4.2,"
SET DIC(0)="L"
SET DLAYGO=4.2
SET X=$PIECE(GECSD,";",4)
SET DIC("DR")="1///S;2///FOC-AUSTIN.DOMAIN.EXT"
DO FILE^DICN
+44 IF Y<1
WRITE !?10,"*** UNABLE TO ADD DOMAIN TO DOMAIN FILE."
SET GECSFLAG=1
QUIT
+45 WRITE !?10,"... DOMAIN ADDED TO DOMAIN FILE."
End DoDot:1
if GECSFLAG
QUIT
+46 ;
+47 SET GECSDOM=$PIECE($GET(^DIC(4.2,+$PIECE(GECSD1,"^",2),0)),"^")
+48 IF $PIECE(GECSD,";",4)'=GECSDOM
Begin DoDot:1
+49 WRITE !?5,$JUSTIFY(GECSERR,2),". ERROR -- DOMAIN MAIL ROUTER SHOULD EQUAL '",$PIECE(GECSD,";",4),"' "
if $LENGTH(GECSDOM)>5
WRITE !?46
WRITE "[NOT '",GECSDOM,"']"
SET GECSERR=GECSERR+1
+50 IF GECSFIX
SET $PIECE(GECSDIE,"^")=$PIECE(GECSD,";",4)
WRITE !?10,"... FIXING DOMAIN MAIL ROUTER."
End DoDot:1
+51 IF $PIECE(GECSD1,"^",3)'=1
Begin DoDot:1
+52 WRITE !?5,$JUSTIFY(GECSERR,2),". ERROR -- TRANSMIT SHOULD BE 'YES' [NOT 'NO']"
SET GECSERR=GECSERR+1
+53 IF GECSFIX
SET $PIECE(GECSDIE,"^",2)="Y"
WRITE !?10,"... FIXING TRANSMIT (TO YES)."
End DoDot:1
+54 IF GECSFIX
IF GECSDIE'=""
Begin DoDot:1
+55 NEW D,D0,DA,DI,DIC,DIE,DQ,DR,X
+56 SET DR=""
IF $PIECE(GECSDIE,"^")'=""
SET DR="1///"_$PIECE(GECSD,";",4)_";"
+57 IF $PIECE(GECSDIE,"^",2)'=""
SET DR=DR_"2///1"
+58 SET (DIE,DIC)="^GECS(2101.1,"_GECSDA_",2,"
SET DA(1)=GECSDA
SET DA=GECSDA1
DO ^DIE
End DoDot:1
+59 ;
+60 SET X=$PIECE($PIECE($PIECE(GECSD,";",4),"-",2),".",1)
+61 IF X=""
WRITE !?5,$JUSTIFY(GECSERR,2),". ERROR -- NO MAIL GROUP DEFINED."
SET GECSERR=GECSERR+1
QUIT
+62 SET DIC="^XMB(3.8,"
SET DIC(0)="X"
DO ^DIC
IF Y<0
WRITE !?5,$JUSTIFY(GECSERR,2),". ERROR -- THE MAIL GROUP '",X,"' NEEDS TO BE SET UP."
SET GECSERR=GECSERR+1
+63 QUIT
