EEOEXMT1 ;HISC/JWR - PREPARES DATA FOR TRANSMITION ;01/17/94 14:00
;;2.0;EEO Complaint Tracking;**10**;AUG-20-96
TASK ;Entry point for transmission to Nat'l data base of formal complaints marked for transmission, and local timeliness reminder bulletins
K ^TMP("EEOXMT") S DA=0
F S DA=$O(^EEO(785,DA)) Q:DA=""!(+DA'=DA) I $P($G(^(DA,"XMT")),U)'="" D INFO
D ^EEOEXMT2
K ^XTMP("EEOX")
I DT#2=0 S EFLG="P" D ^EEOETICK
I DT#4=0 S EFLG="" D ^EEOETICK
D ERAS Q
SINGLE ;Entry point for selecting individual complaints to be transmitted immediately
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"
LOP ;Gathers complaints to be transmitted through the menu option and transmits
D ^DIC S DA=$P(Y,U) Q:DA'>0 D INFO S DIC("A")="Another: ",EEONE(DA)="" D LOP
D ^EEOEXMT2
I $O(EEONE(""))>0 F S DA=$O(EEONE(DA)) Q:DA'>0 D
.S DIE=785,DR="62///@" D ^DIE
K EEONE Q
INFO ;Gathers the data from the global for the complaints to be retransmitted
F NO=0:1:4,5,6,12 S LABEL="ANODE",EEOS="EEON"_NO,@EEOS=$G(^EEO(785,DA,NO)) D
.I $D(^XTMP("EEOX",DA,NO)) D DELETE
.Q:@EEOS=""
.D:NO=0!(NO=5)!(NO=3)!(NO=1) @("EEO"_NO) D SAVE
S LABEL="CORR",NEE="C",NOD=8,PFILE=785.2 D MULT
S LABEL="BASIS",NEE="B",NOD=9,PFILE=785.1 D MULT
S LABEL="ISSUE",NEE="I",NOD=10,PFILE=786 D MULT
S LABEL="INVEST",NEE="IN",NOD=11,PFILE=787.5 D MULT
Q
MULT ;HANDLES MULTIPLES FOR BASIS, ISSUES, AND CORRECTIVE ACTION
D DELTA
Q:$O(^EEO(785,DA,NOD,""))="" K CNT D
.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
Q
SAVEM ;Saves multiples data to transmission file (^TMP)
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:"")
I $G(EEO(NOD,CNT))'="" S ^TMP("EEOXMT",$J,785,DA,LABEL,NOD,CNT)=EEO(NOD,CNT)
Q
EEO0 ;Puts ^EEO(785,DA,0) node information into proper format
;S:$P(EEON0,U,3)'=""&($P(EEON0,U,3)'="@") $P(EEON0,U,3)=$P($G(^DIC(4,$P(EEON0,U,3),0)),U)
S:$P(EEON0,U,4)'=""&($P(EEON0,U,4)'="@") $P(EEON0,U,4)=$P($G(^ECC(730,$P(EEON0,U,4),0)),U)
S:$P(EEON0,U,6)'=""&($P(EEON0,U,6)'="@") $P(EEON0,U,6)=$P($G(^DIC(5,$P(EEON0,U,6),0)),U)
S:$P(EEON0,U,11)'=""&($P(EEON0,U,11)'="@") $P(EEON0,U,11)=$P($G(^DIC(5,$P(EEON0,U,11),0)),U)
Q
EEO5 ;Puts ^EEO(785,DA,5) node information into proper format
S:$P(EEON5,U,4)'=""&($P(EEON5,U,4)'="@") $P(EEON5,U,4)=$P($G(^DIC(5,$P(EEON5,U,4),0)),U)
Q
EEO1 ;Puts ^EEO(785,DA,1) node information into proper format
I +EEON1>0 I $D(^VA(200,+EEON1)) S $P(EEON1,U)=$P(^(+EEON1,0),U)
Q
SAVE ;Saves non-multiple information into global for transmission
S ^TMP("EEOXMT",$J,785,DA,LABEL,NO,"N")=@("EEON"_NO)
Q
DELETE ;Gathers delete information from ^XTMP("EEOX", global for transmit record
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)="@"
K ^XTMP("EEOX",DA,NO)
Q
ERAS ;Gets rid of transmission flag
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
Q
EEO3 ;Eliminates old unused investigator fields from the string for transmission
F PIECE=1,2,4,5,7:1:16 S $P(EEON3,U,PIECE)=""
Q
DELTA ;Multiple field deletes loaded into transmit file
N CNT S CNT=""
I $D(^XTMP("EEOX",DA,NOD)) F S CNT=$O(^XTMP("EEOX",DA,NOD,CNT)) Q:CNT="" D
.F BEE=1:1 Q:$P(^XTMP("EEOX",DA,NOD,CNT),U,BEE,99)="" I $E($P(^(CNT),U,BEE),1)="@" D
..S $P(EEO(NOD,CNT),U,BEE)=$P(^XTMP("EEOX",DA,NOD,CNT),U,BEE)
.D SAVEM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEEOEXMT1 3743 printed Dec 13, 2024@01:51:10 Page 2
EEOEXMT1 ;HISC/JWR - PREPARES DATA FOR TRANSMITION ;01/17/94 14:00
+1 ;;2.0;EEO Complaint Tracking;**10**;AUG-20-96
TASK ;Entry point for transmission to Nat'l data base of formal complaints marked for transmission, and local timeliness reminder bulletins
+1 KILL ^TMP("EEOXMT")
SET DA=0
+2 FOR
SET DA=$ORDER(^EEO(785,DA))
if DA=""!(+DA'=DA)
QUIT
IF $PIECE($GET(^(DA,"XMT")),U)'=""
DO INFO
+3 DO ^EEOEXMT2
+4 KILL ^XTMP("EEOX")
+5 IF DT#2=0
SET EFLG="P"
DO ^EEOETICK
+6 IF DT#4=0
SET EFLG=""
DO ^EEOETICK
+7 DO ERAS
QUIT
SINGLE ;Entry point for selecting individual complaints to be transmitted immediately
+1 SET DIC="^EEO(785,"
SET DIC(0)="AEMQZ"
SET DIC("A")="Select Complainant to transmit: "
SET DIC("S")="I $P($G(^EEO(785,+Y,12)),U,2)'=""D"" I $P($G(^EEO(785,+Y,1)),U,3)>0"
LOP ;Gathers complaints to be transmitted through the menu option and transmits
+1 DO ^DIC
SET DA=$PIECE(Y,U)
if DA'>0
QUIT
DO INFO
SET DIC("A")="Another: "
SET EEONE(DA)=""
DO LOP
+2 DO ^EEOEXMT2
+3 IF $ORDER(EEONE(""))>0
FOR
SET DA=$ORDER(EEONE(DA))
if DA'>0
QUIT
Begin DoDot:1
+4 SET DIE=785
SET DR="62///@"
DO ^DIE
End DoDot:1
+5 KILL EEONE
QUIT
INFO ;Gathers the data from the global for the complaints to be retransmitted
+1 FOR NO=0:1:4,5,6,12
SET LABEL="ANODE"
SET EEOS="EEON"_NO
SET @EEOS=$GET(^EEO(785,DA,NO))
Begin DoDot:1
+2 IF $DATA(^XTMP("EEOX",DA,NO))
DO DELETE
+3 if @EEOS=""
QUIT
+4 if NO=0!(NO=5)!(NO=3)!(NO=1)
DO @("EEO"_NO)
DO SAVE
End DoDot:1
+5 SET LABEL="CORR"
SET NEE="C"
SET NOD=8
SET PFILE=785.2
DO MULT
+6 SET LABEL="BASIS"
SET NEE="B"
SET NOD=9
SET PFILE=785.1
DO MULT
+7 SET LABEL="ISSUE"
SET NEE="I"
SET NOD=10
SET PFILE=786
DO MULT
+8 SET LABEL="INVEST"
SET NEE="IN"
SET NOD=11
SET PFILE=787.5
DO MULT
+9 QUIT
MULT ;HANDLES MULTIPLES FOR BASIS, ISSUES, AND CORRECTIVE ACTION
+1 DO DELTA
+2 if $ORDER(^EEO(785,DA,NOD,""))=""
QUIT
KILL CNT
Begin DoDot:1
+3 SET CNT=0
FOR
SET CNT=$ORDER(^EEO(785,DA,NOD,CNT))
if CNT=""!(+CNT'=CNT)
QUIT
SET EEO(NOD,CNT)=$GET(^(CNT,0))
SET $PIECE(EEO(NOD,CNT),U)=$SELECT($DATA(^EEO(PFILE,$PIECE(EEO(NOD,CNT),U),0)):$PIECE(^(0),U),1:"")
DO DELTA
DO SAVEM
End DoDot:1
+4 QUIT
SAVEM ;Saves multiples data to transmission file (^TMP)
+1 IF NEE="IN"
IF CNT>0
if $PIECE($GET(EEO(NOD,CNT)),U,6)'=""
SET $PIECE(EEO(NOD,CNT),U,6)=$SELECT($DATA(^EEO(PFILE,$PIECE(EEO(NOD,CNT),U,6),0)):$PIECE(^(0),U),1:"")
+2 IF $GET(EEO(NOD,CNT))'=""
SET ^TMP("EEOXMT",$JOB,785,DA,LABEL,NOD,CNT)=EEO(NOD,CNT)
+3 QUIT
EEO0 ;Puts ^EEO(785,DA,0) node information into proper format
+1 ;S:$P(EEON0,U,3)'=""&($P(EEON0,U,3)'="@") $P(EEON0,U,3)=$P($G(^DIC(4,$P(EEON0,U,3),0)),U)
+2 if $PIECE(EEON0,U,4)'=""&($PIECE(EEON0,U,4)'="@")
SET $PIECE(EEON0,U,4)=$PIECE($GET(^ECC(730,$PIECE(EEON0,U,4),0)),U)
+3 if $PIECE(EEON0,U,6)'=""&($PIECE(EEON0,U,6)'="@")
SET $PIECE(EEON0,U,6)=$PIECE($GET(^DIC(5,$PIECE(EEON0,U,6),0)),U)
+4 if $PIECE(EEON0,U,11)'=""&($PIECE(EEON0,U,11)'="@")
SET $PIECE(EEON0,U,11)=$PIECE($GET(^DIC(5,$PIECE(EEON0,U,11),0)),U)
+5 QUIT
EEO5 ;Puts ^EEO(785,DA,5) node information into proper format
+1 if $PIECE(EEON5,U,4)'=""&($PIECE(EEON5,U,4)'="@")
SET $PIECE(EEON5,U,4)=$PIECE($GET(^DIC(5,$PIECE(EEON5,U,4),0)),U)
+2 QUIT
EEO1 ;Puts ^EEO(785,DA,1) node information into proper format
+1 IF +EEON1>0
IF $DATA(^VA(200,+EEON1))
SET $PIECE(EEON1,U)=$PIECE(^(+EEON1,0),U)
+2 QUIT
SAVE ;Saves non-multiple information into global for transmission
+1 SET ^TMP("EEOXMT",$JOB,785,DA,LABEL,NO,"N")=@("EEON"_NO)
+2 QUIT
DELETE ;Gathers delete information from ^XTMP("EEOX", global for transmit record
+1 FOR PIECE=1:1
if $PIECE(^XTMP("EEOX",DA,NO),U,PIECE,PIECE+100)=""
QUIT
IF $PIECE(^(NO),U,PIECE)'=""
if $PIECE(@EEOS,U,PIECE)=""
SET $PIECE(@("EEON"_NO),U,PIECE)="@"
+2 KILL ^XTMP("EEOX",DA,NO)
+3 QUIT
ERAS ;Gets rid of transmission flag
+1 SET DA=0
FOR
SET DA=$ORDER(^EEO(785,DA))
if DA=""!(+DA'=DA)
QUIT
IF $PIECE($GET(^(DA,"XMT")),U)'=""
SET DIE=785
SET DR="62///@"
DO ^DIE
+2 QUIT
EEO3 ;Eliminates old unused investigator fields from the string for transmission
+1 FOR PIECE=1,2,4,5,7:1:16
SET $PIECE(EEON3,U,PIECE)=""
+2 QUIT
DELTA ;Multiple field deletes loaded into transmit file
+1 NEW CNT
SET CNT=""
+2 IF $DATA(^XTMP("EEOX",DA,NOD))
FOR
SET CNT=$ORDER(^XTMP("EEOX",DA,NOD,CNT))
if CNT=""
QUIT
Begin DoDot:1
+3 FOR BEE=1:1
if $PIECE(^XTMP("EEOX",DA,NOD,CNT),U,BEE,99)=""
QUIT
IF $EXTRACT($PIECE(^(CNT),U,BEE),1)="@"
Begin DoDot:2
+4 SET $PIECE(EEO(NOD,CNT),U,BEE)=$PIECE(^XTMP("EEOX",DA,NOD,CNT),U,BEE)
End DoDot:2
+5 DO SAVEM
End DoDot:1
