70 lines
3.8 KiB
Mathematica
70 lines
3.8 KiB
Mathematica
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.VA.GOV" 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
|