Routine: GECSVFY1

GECSVFY1 ;WISC/RFJ-verify and check code sheet parameters (check)   ;18 Nov 93

 ;;2.0;GCS;;MAR 14, 1995

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

GECSVFY1.m