source: WorldVistAEHR/trunk/r/EEO_COMPLAINT_TRACKING-EEO/EEOEXMT1.m@ 1766

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1EEOEXMT1 ;HISC/JWR - PREPARES DATA FOR TRANSMITION ;01/17/94 14:00
2 ;;2.0;EEO Complaint Tracking;**10**;AUG-20-96
3TASK ;Entry point for transmission to Nat'l data base of formal complaints marked for transmission, and local timeliness reminder bulletins
4 K ^TMP("EEOXMT") S DA=0
5 F S DA=$O(^EEO(785,DA)) Q:DA=""!(+DA'=DA) I $P($G(^(DA,"XMT")),U)'="" D INFO
6 D ^EEOEXMT2
7 K ^XTMP("EEOX")
8 I DT#2=0 S EFLG="P" D ^EEOETICK
9 I DT#4=0 S EFLG="" D ^EEOETICK
10 D ERAS Q
11SINGLE ;Entry point for selecting individual complaints to be transmitted immediately
12 S DIC="^EEO(785,",DIC(0)="AEMQZ",DIC("A")="Select Complainant to transmit: ",DIC("S")="I $P($G(^EEO(785,+Y,12)),U,2)'=""D"" I $P($G(^EEO(785,+Y,1)),U,3)>0"
13LOP ;Gathers complaints to be transmitted through the menu option and transmits
14 D ^DIC S DA=$P(Y,U) Q:DA'>0 D INFO S DIC("A")="Another: ",EEONE(DA)="" D LOP
15 D ^EEOEXMT2
16 I $O(EEONE(""))>0 F S DA=$O(EEONE(DA)) Q:DA'>0 D
17 .S DIE=785,DR="62///@" D ^DIE
18 K EEONE Q
19INFO ;Gathers the data from the global for the complaints to be retransmitted
20 F NO=0:1:4,5,6,12 S LABEL="ANODE",EEOS="EEON"_NO,@EEOS=$G(^EEO(785,DA,NO)) D
21 .I $D(^XTMP("EEOX",DA,NO)) D DELETE
22 .Q:@EEOS=""
23 .D:NO=0!(NO=5)!(NO=3)!(NO=1) @("EEO"_NO) D SAVE
24 S LABEL="CORR",NEE="C",NOD=8,PFILE=785.2 D MULT
25 S LABEL="BASIS",NEE="B",NOD=9,PFILE=785.1 D MULT
26 S LABEL="ISSUE",NEE="I",NOD=10,PFILE=786 D MULT
27 S LABEL="INVEST",NEE="IN",NOD=11,PFILE=787.5 D MULT
28 Q
29MULT ;HANDLES MULTIPLES FOR BASIS, ISSUES, AND CORRECTIVE ACTION
30 D DELTA
31 Q:$O(^EEO(785,DA,NOD,""))="" K CNT D
32 .S CNT=0 F S CNT=$O(^EEO(785,DA,NOD,CNT)) Q:CNT=""!(+CNT'=CNT) S EEO(NOD,CNT)=$G(^(CNT,0)),$P(EEO(NOD,CNT),U)=$S($D(^EEO(PFILE,$P(EEO(NOD,CNT),U),0)):$P(^(0),U),1:"") D DELTA,SAVEM
33 Q
34SAVEM ;Saves multiples data to transmission file (^TMP)
35 I NEE="IN",CNT>0 S:$P($G(EEO(NOD,CNT)),U,6)'="" $P(EEO(NOD,CNT),U,6)=$S($D(^EEO(PFILE,$P(EEO(NOD,CNT),U,6),0)):$P(^(0),U),1:"")
36 I $G(EEO(NOD,CNT))'="" S ^TMP("EEOXMT",$J,785,DA,LABEL,NOD,CNT)=EEO(NOD,CNT)
37 Q
38EEO0 ;Puts ^EEO(785,DA,0) node information into proper format
39 ;S:$P(EEON0,U,3)'=""&($P(EEON0,U,3)'="@") $P(EEON0,U,3)=$P($G(^DIC(4,$P(EEON0,U,3),0)),U)
40 S:$P(EEON0,U,4)'=""&($P(EEON0,U,4)'="@") $P(EEON0,U,4)=$P($G(^ECC(730,$P(EEON0,U,4),0)),U)
41 S:$P(EEON0,U,6)'=""&($P(EEON0,U,6)'="@") $P(EEON0,U,6)=$P($G(^DIC(5,$P(EEON0,U,6),0)),U)
42 S:$P(EEON0,U,11)'=""&($P(EEON0,U,11)'="@") $P(EEON0,U,11)=$P($G(^DIC(5,$P(EEON0,U,11),0)),U)
43 Q
44EEO5 ;Puts ^EEO(785,DA,5) node information into proper format
45 S:$P(EEON5,U,4)'=""&($P(EEON5,U,4)'="@") $P(EEON5,U,4)=$P($G(^DIC(5,$P(EEON5,U,4),0)),U)
46 Q
47EEO1 ;Puts ^EEO(785,DA,1) node information into proper format
48 I +EEON1>0 I $D(^VA(200,+EEON1)) S $P(EEON1,U)=$P(^(+EEON1,0),U)
49 Q
50SAVE ;Saves non-multiple information into global for transmission
51 S ^TMP("EEOXMT",$J,785,DA,LABEL,NO,"N")=@("EEON"_NO)
52 Q
53DELETE ;Gathers delete information from ^XTMP("EEOX", global for transmit record
54 F PIECE=1:1 Q:$P(^XTMP("EEOX",DA,NO),U,PIECE,PIECE+100)="" I $P(^(NO),U,PIECE)'="" S:$P(@EEOS,U,PIECE)="" $P(@("EEON"_NO),U,PIECE)="@"
55 K ^XTMP("EEOX",DA,NO)
56 Q
57ERAS ;Gets rid of transmission flag
58 S DA=0 F S DA=$O(^EEO(785,DA)) Q:DA=""!(+DA'=DA) I $P($G(^(DA,"XMT")),U)'="" S DIE=785,DR="62///@" D ^DIE
59 Q
60EEO3 ;Eliminates old unused investigator fields from the string for transmission
61 F PIECE=1,2,4,5,7:1:16 S $P(EEON3,U,PIECE)=""
62 Q
63DELTA ;Multiple field deletes loaded into transmit file
64 N CNT S CNT=""
65 I $D(^XTMP("EEOX",DA,NOD)) F S CNT=$O(^XTMP("EEOX",DA,NOD,CNT)) Q:CNT="" D
66 .F BEE=1:1 Q:$P(^XTMP("EEOX",DA,NOD,CNT),U,BEE,99)="" I $E($P(^(CNT),U,BEE),1)="@" D
67 ..S $P(EEO(NOD,CNT),U,BEE)=$P(^XTMP("EEOX",DA,NOD,CNT),U,BEE)
68 .D SAVEM
Note: See TracBrowser for help on using the repository browser.