source: WorldVistAEHR/trunk/r/GENERIC_CODE_SHEET-GEC/GECSVFY1.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.8 KB
Line 
1GECSVFY1 ;WISC/RFJ-verify and check code sheet parameters (check) ;18 Nov 93
2 ;;2.0;GCS;;MAR 14, 1995
3 Q
4 ;
5 ;
6CHECK ; check batch type
7 N %,GECSDA,GECSDA1,GECSD1,GECSDIE,GECSDOM,X
8 S %="",$P(%,"-",80)=""
9 W !,%,!,"checking batch type: ",$P(GECSD,";")
10 S GECSFLAG=0,GECSERR=1
11 S GECSDA=+$O(^GECS(2101.1,"B",$P(GECSD,";"),0)),GECSD1=$G(^GECS(2101.1,GECSDA,0))
12 ; batch type not in file, add it
13 I GECSD1="" D Q:GECSFLAG
14 . W !?5,$J(GECSERR,2),". ERROR -- BATCH TYPE NOT FOUND IN FILE 2101.1" I 'GECSFIX S GECSFLAG=1 Q
15 . N D0,DA,DD,DI,DIC,DIE,DQ,DR,DLAYGO,X,Y
16 . 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
17 . I Y<1 S GECSFLAG=1 W !?10,"*** UNABLE TO ADD BATCH TYPE TO FILE 2101.1." Q
18 . S GECSDA=+Y,GECSD1=^GECS(2101.1,GECSDA,0) W !?10,"... BATCH TYPE ADDED TO FILE 2101.1."
19 ;
20 S GECSDIE=""
21 I $P(GECSD,";",2)'=$P(GECSD1,"^",3) D
22 . W !?5,$J(GECSERR,2),". ERROR -- MAX CODE SHEETS PER MESSAGE SHOULD EQUAL '",$P(GECSD,";",2),"' [NOT '",$P(GECSD1,"^",3),"']" S GECSERR=GECSERR+1
23 . I GECSFIX S GECSDIE=$P(GECSD,";",2) W !?10,"... FIXING MAX CODE SHEETS PER MESSAGE."
24 I $P(GECSD,";",3)'=$P(GECSD1,"^",4) D
25 . W !?5,$J(GECSERR,2),". ERROR -- SYSTEM ID SHOULD EQUAL '",$P(GECSD,";",3),"' [NOT '",$P(GECSD1,"^",4),"']" S GECSERR=GECSERR+1
26 . I GECSFIX S $P(GECSDIE,"^",2)=$P(GECSD,";",3) W !?10,"... FIXING SYSTEM ID."
27 I GECSFIX,GECSDIE'="" D
28 . N D,D0,DA,DI,DIC,DIE,DQ,DR,X
29 . S DR="" I $P(GECSDIE,"^")'="" S DR="2///"_$P(GECSDIE,"^")_";"
30 . I $P(GECSDIE,"^",2)'="" S DR=DR_"3///"_$P(GECSDIE,"^",2)
31 . S (DIC,DIE)="^GECS(2101.1,",DA=GECSDA D ^DIE
32 ;
33 I '$D(^GECS(2101.1,GECSDA,2,0)) S ^(0)="^2101.12^^"
34 S GECSDIE="",GECSDA1=+$O(^GECS(2101.1,GECSDA,2,"B","XXX",0)),GECSD1=$G(^GECS(2101.1,GECSDA,2,GECSDA1,0))
35 I GECSD1="" D Q:GECSFLAG
36 . W !?5,$J(GECSERR,2),". ERROR -- RECEIVING USER SHOULD EQUAL 'XXX'" S GECSERR=GECSERR+1
37 . I 'GECSFIX S GECSFLAG=1 Q
38 . N D0,DA,DD,DI,DIC,DIE,DQ,DR,DLAYGO,X,Y
39 . 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
40 . I Y<1 S GECSFLAG=1 W !?10,"*** UNABLE TO ADD RECEIVING USER 'XXX'." Q
41 . S GECSDA1=+Y,GECSD1=^GECS(2101.1,GECSDA,2,GECSDA1,0) W !?10,"... RECEIVING USER 'XXX' ADDED."
42 ;
43 ; check to make sure domain is in domain file
44 S X=$P(GECSD,";",4),X=$O(^DIC(4.2,"B",X,0))
45 I X="" D Q:GECSFLAG
46 . W !?5,$J(GECSERR,2),". ERROR -- DOMAIN '",$P(GECSD,";",4),"' NOT FOUND IN DOMAIN FILE." S GECSERR=GECSERR+1
47 . I 'GECSFIX S GECSFLAG=1 Q
48 . N D0,DA,DD,DI,DIC,DIE,DQ,DR,DLAYGO,X,Y
49 . 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
50 . I Y<1 W !?10,"*** UNABLE TO ADD DOMAIN TO DOMAIN FILE." S GECSFLAG=1 Q
51 . W !?10,"... DOMAIN ADDED TO DOMAIN FILE."
52 ;
53 S GECSDOM=$P($G(^DIC(4.2,+$P(GECSD1,"^",2),0)),"^")
54 I $P(GECSD,";",4)'=GECSDOM D
55 . 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
56 . I GECSFIX S $P(GECSDIE,"^")=$P(GECSD,";",4) W !?10,"... FIXING DOMAIN MAIL ROUTER."
57 I $P(GECSD1,"^",3)'=1 D
58 . W !?5,$J(GECSERR,2),". ERROR -- TRANSMIT SHOULD BE 'YES' [NOT 'NO']" S GECSERR=GECSERR+1
59 . I GECSFIX S $P(GECSDIE,"^",2)="Y" W !?10,"... FIXING TRANSMIT (TO YES)."
60 I GECSFIX,GECSDIE'="" D
61 . N D,D0,DA,DI,DIC,DIE,DQ,DR,X
62 . S DR="" I $P(GECSDIE,"^")'="" S DR="1///"_$P(GECSD,";",4)_";"
63 . I $P(GECSDIE,"^",2)'="" S DR=DR_"2///1"
64 . S (DIE,DIC)="^GECS(2101.1,"_GECSDA_",2,",DA(1)=GECSDA,DA=GECSDA1 D ^DIE
65 ;
66 S X=$P($P($P(GECSD,";",4),"-",2),".",1)
67 I X="" W !?5,$J(GECSERR,2),". ERROR -- NO MAIL GROUP DEFINED." S GECSERR=GECSERR+1 Q
68 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
69 Q
Note: See TracBrowser for help on using the repository browser.