AGRPTEMP ;IHS/SD/TPF - LIST EMPLOYEES BY EMPLOYER
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
;ABILITY TO LIST EMPLOYEES BY EMPLOYER.
;
EN ;EP
K EXCLSION
S $P(AGLINE("EQ"),"=",81)=""
S $P(AGLINE("-"),"-",81)=""
W !,"This program generates a listing of the Employees for each Employer, sorted in alphabetical order."
W !!
K DIR
S DIR("A")="Do you wish the Run the Program"
S DIR("B")="Y"
S DIR(0)="YO"
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))
Q:'Y
K DIR
D MAIN ;MAIN SLECTION DRIVER
D EXIT ;CLEANUP VARS
Q
MAIN ;MAIN SELECTION DRIVER
K ^XTMP("AGRPTEMP",$J),PRINTOUT
D EXCHDR ;PRINT EXCLUSION PARAMETERS CHOSEN BY USER
N TAG
K DIR
S DIR("A")="Select ONE or MORE of the above EXCLUSION PARAMETERS"
S DIR(0)="SO^1:EMP;2:STAT"
S DIR("L",1)="Select one of the following:"
S DIR("L",2)=""
S DIR("L",3)=" 1 EMPLOYER"
S DIR("L",4)=" ALL EMPLOYERS"
S DIR("L",5)=" SPECIFIC EMPLOYERS (enter specific names or from to)"
S DIR("L",6)=" 2 EMPLOYMENT STATUS"
S DIR("L")=" Select Employment Status"
D ^DIR
I X="" D DOSORT(.EXCLSION),DOPRINT("") G MAIN
Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))
S TAG="ASK"_Y(0)
D @TAG
K TAG
G MAIN
Q
ASKEMP ;ASK FOR EMPLOYERS
N TAG
K EXCLSION("Employers")
K DIR
S DIR("A")="Choose one"
S DIR("B")="A"
S DIR(0)="SO^A:ALL;S:SPECIFIC NAMES;F:FROM/TO"
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))
S TAG="EMP"_Y
D @TAG
K TAG,DIR
Q
ASKDATES ;ASK FOR DATE RANGES
K DIR,DTOUT,DUOUT,DIRUT,DIROUT
S DIR("A")="Effective Date"
S:$D(EXCLSION("Effective Date")) DIR("B")=EXCLSION("Effective Date")
S DIR(0)="DO"
D ^DIR
I X="@" K EXCLSION("Effective Date") W "Deleted"
Q:$D(DTOUT)!($D(DUOUT))!($D(DIROUT))
S EFFDATE=$G(Y)
S EXCLSION("Effective Date")=EFFDATE
K DIR
S DIR("A")="Termination Date"
S:$D(EXCLSION("Termination Date")) DIR("B")=EXCLSION("Termination Date")
S DIR(0)="DO"
D ^DIR
I X="@" K EXCLSION("Effective Date") W "Deleted"
Q:$D(DTOUT)!($D(DUOUT))!($D(DIROUT))
S TERMDATE=$G(Y)
S EXCLSION("Termination Date")=TERMDATE
K:EXCLSION("Termination Date")="" EXCLSION("Termination Date")
Q
ASKSTAT ;ASK FOR STATUS FULL,PART ETC
N CODES
K DIR
S CODES=$P($G(^DD(9000001,.21,0)),U,3)
S DIR("A")="Employment Status"
S DIR(0)="SO"_U_CODES_"A:ALL"
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))
S EMPSTAT=Y(0)
S EXCLSION("Employment Status")=Y_U_Y(0)
K:EXCLSION("Employment Status")="" EXCLSION("Employment Status")
Q
EMPA ;DO ALL EMPLOYERS
W !,"YOU CHOSE DO ALL EMPLOYERS"
S EXCLSION("Employers")="ALL"
Q
EMPS ;ALLOW SELECTION OF SPECIFIC EMPLOYERS
W !,"YOU CHOSE TO DO SPECIFIC EMPLOYERS"
S EXCLSION("Employers")="SPECIFIC EMPLOYERS"
EMPS1 K DIR,DTOUT,DUOUT,DIRUT,DIROUT
S DIR(0)="PO^9999999.75:AEM"
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))!($D(DIROUT))
I X="@" K EXCLSION("Employers") Q
Q:X=""
S EXCLSION("Employers",+Y)=Y
G:+Y EMPS1
Q
EMPF ;ALLOW SELECTION OF FROM/TO EMPLOYERS
W !,"YOU CHOSE TO ENTER A RANGE OF EMPLOYERS"
S EXCLSION("Employers")="RANGE OF EMPLOYERS"
S COUNT=0
FROM K DIR,DTOUT,DUOUT,DIRUT,DIROUT
S COUNT=COUNT+1
W !
S DIR("A")="From Employer"
S DIR(0)="PO^9999999.75:AEM"
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))!($D(DIROUT))
I X="@" K EXCLSION("Employers") Q
Q:X=""
S EXCLSION("Employers",COUNT)=Y
TO K DIR,DTOUT,DUOUT,DIRUT,DIROUT
W !
S DIR("A")="To Employer"
S DIR(0)="PO^9999999.75:AEM"
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))!($D(DIROUT))
I X'="",($P(Y,U,2)']$P(EXCLSION("Employers",COUNT),U,2)) W " Incorrect from/to sequence!" G TO
S $P(EXCLSION("Employers",COUNT),"|",2)=Y
G FROM
Q
EXCHDR ;EP
I '$D(PRINTOUT) W @IOF
I $G(EXCLSION("Employers"))="" S EXCLSION("Employers")="ALL"
I $G(EXCLSION("Employment Status"))="" S EXCLSION("Employment Status")="A^ALL"
I '$D(EXCLSION) W !,"NO EXCLUSION PARAMETERS CURRENTLY IN EFFECT" Q
W !,"EXCLUSION PARAMETERS Currently in Effect for RESTRICTING the REPORT to:"
W !,AGLINE("EQ")
W:$G(EXCLSION("Employment Status"))'="" !,"- Employment Status.......: ",$P($G(EXCLSION("Employment Status")),U,2)
W:$G(EXCLSION("Effective Date"))'="" !,"- Effective Date..........: ",$G(EXCLSION("Effective Date"))
W:$G(EXCLSION("Termination Date"))'="" !,"- Termination Date..........: ",$G(EXCLSION("Termination Date"))
I $D(EXCLSION("Employers")) D
.W !,"- Employers: "
.I $P(EXCLSION("Employers"),U)="SPECIFIC EMPLOYERS" D Q
..W "SPECIFIC EMPLOYERS: "
..S EMPREC=""
..F LN=1:1 S EMPREC=$O(EXCLSION("Employers",EMPREC)) Q:EMPREC="" D
...W @$S(LN'=1:"!?35",1:"?35"),$P(EXCLSION("Employers",EMPREC),U,2)
.;
.I $P(EXCLSION("Employers"),U)="RANGE OF EMPLOYERS" D Q
..W "RANGE OF EMPLOYERS: "
..S EMPREC=""
..F LN=1:1 S EMPREC=$O(EXCLSION("Employers",EMPREC)) Q:EMPREC="" D
...W @$S(LN'=1:"!?35",1:"?35"),"From ",$P($P(EXCLSION("Employers",EMPREC),"|"),U,2)," to ",$P($P(EXCLSION("Employers",EMPREC),"|",2),U,2)
.W "ALL EMPLOYERS"
Q
DOSORT(EXCLSION) ;EP - PRINT EMPLOYEES FOR EMPLOYERS SELECTED
S EMPLECNT=0,EMPLRCNT=0
I $G(EXCLSION("Employers"))="ALL" D LOOP("",999999999999999) ;DO ALL EMPLOYERS
I $G(EXCLSION("Employers"))="SPECIFIC EMPLOYERS" D
.S EMPREC=""
.F S EMPREC=$O(EXCLSION("Employers",EMPREC)) Q:EMPREC="" D
..D LOOP(EMPREC-1,EMPREC+1)
I $G(EXCLSION("Employers"))="RANGE OF EMPLOYERS" D
.S EMPREC=""
.F S EMPREC=$O(EXCLSION("Employers",EMPREC)) Q:EMPREC="" D
..S EMPLRBEG=$P($P(EXCLSION("Employers",EMPREC),"|"),U,2)
..S EMPLRBEG=$E(EMPLRBEG,1,$L(EMPLRBEG)-1)_$C($A($E(EMPLRBEG,$L(EMPLRBEG)))-1)
..S EMPLREND=$P($P(EXCLSION("Employers",EMPREC),"|",2),U,2)
..F S EMPLRBEG=$O(^AUTNEMPL("B",EMPLRBEG)) Q:EMPLRBEG]EMPLREND D
...S EMPLRREC=0
...F S EMPLRREC=$O(^AUTNEMPL("B",EMPLRBEG,EMPLRREC)) Q:EMPLRREC="" D
....D LOOP(EMPLRREC-1,EMPLRREC+1)
Q
LOOP(TAREMPLR,ENDEMPLR) ;EP
F S TAREMPLR=$O(^AUPNPAT("AF",TAREMPLR)) Q:TAREMPLR>ENDEMPLR Q:TAREMPLR="" D
.S EMPLRCNT=EMPLRCNT+1
.S EMPLEE=""
.F S EMPLEE=$O(^AUPNPAT("AF",TAREMPLR,EMPLEE)) Q:EMPLEE="" D
..S STATUS=$P($G(^AUPNPAT(EMPLEE,0)),U,21)
..I $G(EXCLSION("Employment Status"))'="",$P($G(EXCLSION("Employment Status")),U,2)'="ALL" Q:STATUS'=+$G(EXCLSION("Employment Status"))
..S HRN=$P($G(^AUPNPAT(EMPLEE,41,DUZ(2),0)),U,2)
..S EMPLEENM=$E($P($G(^DPT(EMPLEE,0)),U),1,15)
..S:EMPLEENM="" EMPLEENM="UNDEFINED"
..S EMPLRNM=$E($P($G(^AUTNEMPL(TAREMPLR,0)),U),1,15)
..S:EMPLRNM="" EMPLRNM="UNDEFINED"
..S STATUS=$P($P($P(^DD(9000001,.21,0),U,3),";",STATUS),":",2)
..S EMPLECNT=EMPLECNT+1
..S ^XTMP("AGRPTEMP",$J,EMPLRNM,EMPLEENM)=STATUS_U_HRN
..S ^XTMP("AGRPTEMP",$J,"EMPLOYER TOTAL")=EMPLRCNT
..S ^XTMP("AGRPTEMP",$J,"EMPLOYEE TOTAL")=EMPLECNT
Q
DOPRINT(GLO) ;PRINT OUT SORTED TEMP GLOBAL
I '$D(^XTMP("AGRPTEMP",$J)) W !,"NO RECORDS FOUND!" H 3 Q
W !,^XTMP("AGRPTEMP",$J,"EMPLOYEE TOTAL")," RECORDS MET THE CRITERIA"
D ^%ZIS Q:POP
U IO
S ESCAPE=0,PAGENO=0
D HDR
S EMPLECNT=^XTMP("AGRPTEMP",$J,"EMPLOYEE TOTAL")
S EMPLRCNT=^XTMP("AGRPTEMP",$J,"EMPLOYER TOTAL")
S EMPLRNM="EMPLOYER TOTAL"
F EMPLRREC=1:1 S EMPLRNM=$O(^XTMP("AGRPTEMP",$J,EMPLRNM)) Q:EMPLRNM=""!(ESCAPE) D
.D HDR
.S EMPLEENM=""
.W !,$E(EMPLRNM,1,15)
.S LINEITEM=0
.F EMPLEREC=1:1 S EMPLEENM=$O(^XTMP("AGRPTEMP",$J,EMPLRNM,EMPLEENM)) Q:EMPLEENM=""!(ESCAPE) D
..S STATUS=$P(^XTMP("AGRPTEMP",$J,EMPLRNM,EMPLEENM),U)
..S HRN=$P(^XTMP("AGRPTEMP",$J,EMPLRNM,EMPLEENM),U,2)
..S LINEITEM=LINEITEM+1
..W @$S(LINEITEM=1:"?20",1:"!?20"),$E(EMPLEENM,1,15),?40,HRN,?50,$P(STATUS,U)
..;NOTE: HEADER IS 10 LINES
..I $Y>(IOSL-10),(IOST[("C-")) W ! K DIR S DIR(0)="E" D ^DIR S ESCAPE=X=U D:'ESCAPE HDR W !,$E(EMPLRNM,1,15) Q
..I $Y>(IOSL-10) D HDR W !,$E(EMPLRNM,1,15)
.W !?20,"========================"
.W !?20,EMPLEREC-1
W !!,"Number of Employers Number of Employees"
W !,EMPLRCNT,?25,EMPLECNT
I (IOST[("C-")) K DIR W ! K DIR S DIR(0)="E" D ^DIR S ESCAPE=X=U D:'ESCAPE HDR Q
D ^%ZISC
Q
HDR ;MAIN HEADER
S PRINTOUT=1
W @IOF
W !,"WARNING: Confidential Patient Information, Privacy Act Applies"
W !,AGLINE("EQ")
D EXCHDR
W !,AGLINE("EQ")
W !,"Employer",?20,"Employee",?40,"HRN",?50,"Status"
W !,AGLINE("-")
S LINEITEM=0
Q
EXIT ;EP - CLEANUP VARS
K EFFDATE,EMPLECNT,COUNT,EMPLEE,EMPLEENM,EMPLEREC,EMPLRBEG,EMPLRCNT,EMPLREND
K EMPLRNM,EMPLRREC,EMPREC
Q
AGRPTEMP ;IHS/SD/TPF - LIST EMPLOYEES BY EMPLOYER
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
+3 ;ABILITY TO LIST EMPLOYEES BY EMPLOYER.
+4 ;
EN ;EP
+1 KILL EXCLSION
+2 SET $PIECE(AGLINE("EQ"),"=",81)=""
+3 SET $PIECE(AGLINE("-"),"-",81)=""
+4 WRITE !,"This program generates a listing of the Employees for each Employer, sorted in alphabetical order."
+5 WRITE !!
+6 KILL DIR
+7 SET DIR("A")="Do you wish the Run the Program"
+8 SET DIR("B")="Y"
+9 SET DIR(0)="YO"
+10 DO ^DIR
+11 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))
QUIT
+12 IF 'Y
QUIT
+13 KILL DIR
+14 ;MAIN SLECTION DRIVER
DO MAIN
+15 ;CLEANUP VARS
DO EXIT
+16 QUIT
MAIN ;MAIN SELECTION DRIVER
+1 KILL ^XTMP("AGRPTEMP",$JOB),PRINTOUT
+2 ;PRINT EXCLUSION PARAMETERS CHOSEN BY USER
DO EXCHDR
+3 NEW TAG
+4 KILL DIR
+5 SET DIR("A")="Select ONE or MORE of the above EXCLUSION PARAMETERS"
+6 SET DIR(0)="SO^1:EMP;2:STAT"
+7 SET DIR("L",1)="Select one of the following:"
+8 SET DIR("L",2)=""
+9 SET DIR("L",3)=" 1 EMPLOYER"
+10 SET DIR("L",4)=" ALL EMPLOYERS"
+11 SET DIR("L",5)=" SPECIFIC EMPLOYERS (enter specific names or from to)"
+12 SET DIR("L",6)=" 2 EMPLOYMENT STATUS"
+13 SET DIR("L")=" Select Employment Status"
+14 DO ^DIR
+15 IF X=""
DO DOSORT(.EXCLSION)
DO DOPRINT("")
GOTO MAIN
+16 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))
QUIT
+17 SET TAG="ASK"_Y(0)
+18 DO @TAG
+19 KILL TAG
+20 GOTO MAIN
+21 QUIT
ASKEMP ;ASK FOR EMPLOYERS
+1 NEW TAG
+2 KILL EXCLSION("Employers")
+3 KILL DIR
+4 SET DIR("A")="Choose one"
+5 SET DIR("B")="A"
+6 SET DIR(0)="SO^A:ALL;S:SPECIFIC NAMES;F:FROM/TO"
+7 DO ^DIR
+8 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))
QUIT
+9 SET TAG="EMP"_Y
+10 DO @TAG
+11 KILL TAG,DIR
+12 QUIT
ASKDATES ;ASK FOR DATE RANGES
+1 KILL DIR,DTOUT,DUOUT,DIRUT,DIROUT
+2 SET DIR("A")="Effective Date"
+3 IF $DATA(EXCLSION("Effective Date"))
SET DIR("B")=EXCLSION("Effective Date")
+4 SET DIR(0)="DO"
+5 DO ^DIR
+6 IF X="@"
KILL EXCLSION("Effective Date")
WRITE "Deleted"
+7 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
QUIT
+8 SET EFFDATE=$GET(Y)
+9 SET EXCLSION("Effective Date")=EFFDATE
+10 KILL DIR
+11 SET DIR("A")="Termination Date"
+12 IF $DATA(EXCLSION("Termination Date"))
SET DIR("B")=EXCLSION("Termination Date")
+13 SET DIR(0)="DO"
+14 DO ^DIR
+15 IF X="@"
KILL EXCLSION("Effective Date")
WRITE "Deleted"
+16 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
QUIT
+17 SET TERMDATE=$GET(Y)
+18 SET EXCLSION("Termination Date")=TERMDATE
+19 IF EXCLSION("Termination Date")=""
KILL EXCLSION("Termination Date")
+20 QUIT
ASKSTAT ;ASK FOR STATUS FULL,PART ETC
+1 NEW CODES
+2 KILL DIR
+3 SET CODES=$PIECE($GET(^DD(9000001,.21,0)),U,3)
+4 SET DIR("A")="Employment Status"
+5 SET DIR(0)="SO"_U_CODES_"A:ALL"
+6 DO ^DIR
+7 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))
QUIT
+8 SET EMPSTAT=Y(0)
+9 SET EXCLSION("Employment Status")=Y_U_Y(0)
+10 IF EXCLSION("Employment Status")=""
KILL EXCLSION("Employment Status")
+11 QUIT
EMPA ;DO ALL EMPLOYERS
+1 WRITE !,"YOU CHOSE DO ALL EMPLOYERS"
+2 SET EXCLSION("Employers")="ALL"
+3 QUIT
EMPS ;ALLOW SELECTION OF SPECIFIC EMPLOYERS
+1 WRITE !,"YOU CHOSE TO DO SPECIFIC EMPLOYERS"
+2 SET EXCLSION("Employers")="SPECIFIC EMPLOYERS"
EMPS1 KILL DIR,DTOUT,DUOUT,DIRUT,DIROUT
+1 SET DIR(0)="PO^9999999.75:AEM"
+2 DO ^DIR
+3 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
QUIT
+4 IF X="@"
KILL EXCLSION("Employers")
QUIT
+5 IF X=""
QUIT
+6 SET EXCLSION("Employers",+Y)=Y
+7 IF +Y
GOTO EMPS1
+8 QUIT
EMPF ;ALLOW SELECTION OF FROM/TO EMPLOYERS
+1 WRITE !,"YOU CHOSE TO ENTER A RANGE OF EMPLOYERS"
+2 SET EXCLSION("Employers")="RANGE OF EMPLOYERS"
+3 SET COUNT=0
FROM KILL DIR,DTOUT,DUOUT,DIRUT,DIROUT
+1 SET COUNT=COUNT+1
+2 WRITE !
+3 SET DIR("A")="From Employer"
+4 SET DIR(0)="PO^9999999.75:AEM"
+5 DO ^DIR
+6 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
QUIT
+7 IF X="@"
KILL EXCLSION("Employers")
QUIT
+8 IF X=""
QUIT
+9 SET EXCLSION("Employers",COUNT)=Y
TO KILL DIR,DTOUT,DUOUT,DIRUT,DIROUT
+1 WRITE !
+2 SET DIR("A")="To Employer"
+3 SET DIR(0)="PO^9999999.75:AEM"
+4 DO ^DIR
+5 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
QUIT
+6 IF X'=""
IF ($PIECE(Y,U,2)']$PIECE(EXCLSION("Employers",COUNT),U,2))
WRITE " Incorrect from/to sequence!"
GOTO TO
+7 SET $PIECE(EXCLSION("Employers",COUNT),"|",2)=Y
+8 GOTO FROM
+9 QUIT
EXCHDR ;EP
+1 IF '$DATA(PRINTOUT)
WRITE @IOF
+2 IF $GET(EXCLSION("Employers"))=""
SET EXCLSION("Employers")="ALL"
+3 IF $GET(EXCLSION("Employment Status"))=""
SET EXCLSION("Employment Status")="A^ALL"
+4 IF '$DATA(EXCLSION)
WRITE !,"NO EXCLUSION PARAMETERS CURRENTLY IN EFFECT"
QUIT
+5 WRITE !,"EXCLUSION PARAMETERS Currently in Effect for RESTRICTING the REPORT to:"
+6 WRITE !,AGLINE("EQ")
+7 IF $GET(EXCLSION("Employment Status"))'=""
WRITE !,"- Employment Status.......: ",$PIECE($GET(EXCLSION("Employment Status")),U,2)
+8 IF $GET(EXCLSION("Effective Date"))'=""
WRITE !,"- Effective Date..........: ",$GET(EXCLSION("Effective Date"))
+9 IF $GET(EXCLSION("Termination Date"))'=""
WRITE !,"- Termination Date..........: ",$GET(EXCLSION("Termination Date"))
+10 IF $DATA(EXCLSION("Employers"))
Begin DoDot:1
+11 WRITE !,"- Employers: "
+12 IF $PIECE(EXCLSION("Employers"),U)="SPECIFIC EMPLOYERS"
Begin DoDot:2
+13 WRITE "SPECIFIC EMPLOYERS: "
+14 SET EMPREC=""
+15 FOR LN=1:1
SET EMPREC=$ORDER(EXCLSION("Employers",EMPREC))
IF EMPREC=""
QUIT
Begin DoDot:3
+16 WRITE @$SELECT(LN'=1:"!?35",1:"?35"),$PIECE(EXCLSION("Employers",EMPREC),U,2)
End DoDot:3
End DoDot:2
QUIT
+17 ;
+18 IF $PIECE(EXCLSION("Employers"),U)="RANGE OF EMPLOYERS"
Begin DoDot:2
+19 WRITE "RANGE OF EMPLOYERS: "
+20 SET EMPREC=""
+21 FOR LN=1:1
SET EMPREC=$ORDER(EXCLSION("Employers",EMPREC))
IF EMPREC=""
QUIT
Begin DoDot:3
+22 WRITE @$SELECT(LN'=1:"!?35",1:"?35"),"From ",$PIECE($PIECE(EXCLSION("Employers",EMPREC),"|"),U,2)," to ",$PIECE($PIECE(EXCLSION("Employers",EMPREC),"|",2),U,2)
End DoDot:3
End DoDot:2
QUIT
+23 WRITE "ALL EMPLOYERS"
End DoDot:1
+24 QUIT
DOSORT(EXCLSION) ;EP - PRINT EMPLOYEES FOR EMPLOYERS SELECTED
+1 SET EMPLECNT=0
SET EMPLRCNT=0
+2 ;DO ALL EMPLOYERS
IF $GET(EXCLSION("Employers"))="ALL"
DO LOOP("",999999999999999)
+3 IF $GET(EXCLSION("Employers"))="SPECIFIC EMPLOYERS"
Begin DoDot:1
+4 SET EMPREC=""
+5 FOR
SET EMPREC=$ORDER(EXCLSION("Employers",EMPREC))
IF EMPREC=""
QUIT
Begin DoDot:2
+6 DO LOOP(EMPREC-1,EMPREC+1)
End DoDot:2
End DoDot:1
+7 IF $GET(EXCLSION("Employers"))="RANGE OF EMPLOYERS"
Begin DoDot:1
+8 SET EMPREC=""
+9 FOR
SET EMPREC=$ORDER(EXCLSION("Employers",EMPREC))
IF EMPREC=""
QUIT
Begin DoDot:2
+10 SET EMPLRBEG=$PIECE($PIECE(EXCLSION("Employers",EMPREC),"|"),U,2)
+11 SET EMPLRBEG=$EXTRACT(EMPLRBEG,1,$LENGTH(EMPLRBEG)-1)_$CHAR($ASCII($EXTRACT(EMPLRBEG,$LENGTH(EMPLRBEG)))-1)
+12 SET EMPLREND=$PIECE($PIECE(EXCLSION("Employers",EMPREC),"|",2),U,2)
+13 FOR
SET EMPLRBEG=$ORDER(^AUTNEMPL("B",EMPLRBEG))
IF EMPLRBEG]EMPLREND
QUIT
Begin DoDot:3
+14 SET EMPLRREC=0
+15 FOR
SET EMPLRREC=$ORDER(^AUTNEMPL("B",EMPLRBEG,EMPLRREC))
IF EMPLRREC=""
QUIT
Begin DoDot:4
+16 DO LOOP(EMPLRREC-1,EMPLRREC+1)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT
LOOP(TAREMPLR,ENDEMPLR) ;EP
+1 FOR
SET TAREMPLR=$ORDER(^AUPNPAT("AF",TAREMPLR))
IF TAREMPLR>ENDEMPLR
QUIT
IF TAREMPLR=""
QUIT
Begin DoDot:1
+2 SET EMPLRCNT=EMPLRCNT+1
+3 SET EMPLEE=""
+4 FOR
SET EMPLEE=$ORDER(^AUPNPAT("AF",TAREMPLR,EMPLEE))
IF EMPLEE=""
QUIT
Begin DoDot:2
+5 SET STATUS=$PIECE($GET(^AUPNPAT(EMPLEE,0)),U,21)
+6 IF $GET(EXCLSION("Employment Status"))'=""
IF $PIECE($GET(EXCLSION("Employment Status")),U,2)'="ALL"
IF STATUS'=+$GET(EXCLSION("Employment Status"))
QUIT
+7 SET HRN=$PIECE($GET(^AUPNPAT(EMPLEE,41,DUZ(2),0)),U,2)
+8 SET EMPLEENM=$EXTRACT($PIECE($GET(^DPT(EMPLEE,0)),U),1,15)
+9 IF EMPLEENM=""
SET EMPLEENM="UNDEFINED"
+10 SET EMPLRNM=$EXTRACT($PIECE($GET(^AUTNEMPL(TAREMPLR,0)),U),1,15)
+11 IF EMPLRNM=""
SET EMPLRNM="UNDEFINED"
+12 SET STATUS=$PIECE($PIECE($PIECE(^DD(9000001,.21,0),U,3),";",STATUS),":",2)
+13 SET EMPLECNT=EMPLECNT+1
+14 SET ^XTMP("AGRPTEMP",$JOB,EMPLRNM,EMPLEENM)=STATUS_U_HRN
+15 SET ^XTMP("AGRPTEMP",$JOB,"EMPLOYER TOTAL")=EMPLRCNT
+16 SET ^XTMP("AGRPTEMP",$JOB,"EMPLOYEE TOTAL")=EMPLECNT
End DoDot:2
End DoDot:1
+17 QUIT
DOPRINT(GLO) ;PRINT OUT SORTED TEMP GLOBAL
+1 IF '$DATA(^XTMP("AGRPTEMP",$JOB))
WRITE !,"NO RECORDS FOUND!"
HANG 3
QUIT
+2 WRITE !,^XTMP("AGRPTEMP",$JOB,"EMPLOYEE TOTAL")," RECORDS MET THE CRITERIA"
+3 DO ^%ZIS
IF POP
QUIT
+4 USE IO
+5 SET ESCAPE=0
SET PAGENO=0
+6 DO HDR
+7 SET EMPLECNT=^XTMP("AGRPTEMP",$JOB,"EMPLOYEE TOTAL")
+8 SET EMPLRCNT=^XTMP("AGRPTEMP",$JOB,"EMPLOYER TOTAL")
+9 SET EMPLRNM="EMPLOYER TOTAL"
+10 FOR EMPLRREC=1:1
SET EMPLRNM=$ORDER(^XTMP("AGRPTEMP",$JOB,EMPLRNM))
IF EMPLRNM=""!(ESCAPE)
QUIT
Begin DoDot:1
+11 DO HDR
+12 SET EMPLEENM=""
+13 WRITE !,$EXTRACT(EMPLRNM,1,15)
+14 SET LINEITEM=0
+15 FOR EMPLEREC=1:1
SET EMPLEENM=$ORDER(^XTMP("AGRPTEMP",$JOB,EMPLRNM,EMPLEENM))
IF EMPLEENM=""!(ESCAPE)
QUIT
Begin DoDot:2
+16 SET STATUS=$PIECE(^XTMP("AGRPTEMP",$JOB,EMPLRNM,EMPLEENM),U)
+17 SET HRN=$PIECE(^XTMP("AGRPTEMP",$JOB,EMPLRNM,EMPLEENM),U,2)
+18 SET LINEITEM=LINEITEM+1
+19 WRITE @$SELECT(LINEITEM=1:"?20",1:"!?20"),$EXTRACT(EMPLEENM,1,15),?40,HRN,?50,$PIECE(STATUS,U)
+20 ;NOTE: HEADER IS 10 LINES
+21 IF $Y>(IOSL-10)
IF (IOST[("C-"))
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
SET ESCAPE=X=U
IF 'ESCAPE
DO HDR
WRITE !,$EXTRACT(EMPLRNM,1,15)
QUIT
+22 IF $Y>(IOSL-10)
DO HDR
WRITE !,$EXTRACT(EMPLRNM,1,15)
End DoDot:2
+23 WRITE !?20,"========================"
+24 WRITE !?20,EMPLEREC-1
End DoDot:1
+25 WRITE !!,"Number of Employers Number of Employees"
+26 WRITE !,EMPLRCNT,?25,EMPLECNT
+27 IF (IOST[("C-"))
KILL DIR
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
SET ESCAPE=X=U
IF 'ESCAPE
DO HDR
QUIT
+28 DO ^%ZISC
+29 QUIT
HDR ;MAIN HEADER
+1 SET PRINTOUT=1
+2 WRITE @IOF
+3 WRITE !,"WARNING: Confidential Patient Information, Privacy Act Applies"
+4 WRITE !,AGLINE("EQ")
+5 DO EXCHDR
+6 WRITE !,AGLINE("EQ")
+7 WRITE !,"Employer",?20,"Employee",?40,"HRN",?50,"Status"
+8 WRITE !,AGLINE("-")
+9 SET LINEITEM=0
+10 QUIT
EXIT ;EP - CLEANUP VARS
+1 KILL EFFDATE,EMPLECNT,COUNT,EMPLEE,EMPLEENM,EMPLEREC,EMPLRBEG,EMPLRCNT,EMPLREND
+2 KILL EMPLRNM,EMPLRREC,EMPREC
+3 QUIT
