- IBOEMP2 ;ALB/ARH - EMPLOYER REPORT (PRINT) ; 6/19/93
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;
- ;Array: patient: DFN)=pt name ^ SSN ^ event date ^ appt type ^ prim elig
- ; employed: DFN,x)=name ^ occupation ^ employment status ^ SSN
- ; employer: "E",EMPLOYER NAME)=count of employees per employer name
- ; "E",EMPLOYER NAME,y)=employer address
- ; "E",EMPLOYER NAME,y,PATIENT NAME,DFN,x)=""
- ;
- ; w/x = "P" if employed is patient, "S" for spouse otherwise
- ; y = number of employers with same name but not the same address, ie. 1:1:...
- ;
- ;
- D HDR
- ;
- P1 ;print report
- Q:'$D(^TMP("IBEMP",$J)) S IBW=IOM
- S IBADDN="" F S IBADDN=$O(^TMP("IBEMP",$J,"E",IBADDN)) Q:IBADDN=""!(IBQ) S IBCNT=^TMP("IBEMP",$J,"E",IBADDN),IBX="" D Q:IBQ
- . F S IBX=$O(^TMP("IBEMP",$J,"E",IBADDN,IBX)) Q:IBX=""!(IBQ) D:(IBLN+9)>IOSL HDR Q:IBQ D W !!,IBDSH,! S IBLN=IBLN+2
- .. ;
- .. ;print employer name and address
- .. S IBADD=^TMP("IBEMP",$J,"E",IBADDN,IBX) W !,$E($P(IBADD,"^",1),1,29),?32,$P(IBADD,"^",8),?55 S IBLNG=55,IBLN=IBLN+2
- .. F IBI=2:1:7 S IBP=$P(IBADD,"^",IBI) I IBP'="" S IBP=IBP_$S(IBI<6:",",IBI=6:" ",1:"") D
- ... F S IBE=$P(IBP," ",1)_" ",IBP=$P(IBP," ",2,999) D W ?IBLNG,IBE S IBLNG=IBLNG+IBT Q:IBP=""
- .... S IBT=$L(IBE) I (IBT+IBLNG)>IOM S IBLNG=55,IBLN=IBLN+1 W !
- .. ;
- .. ;print patient data
- .. S IBPTNM="" F S IBPTNM=$O(^TMP("IBEMP",$J,"E",IBADDN,IBX,IBPTNM)) Q:IBPTNM="" D Q:IBQ
- ... S IBDFN="" F S IBDFN=$O(^TMP("IBEMP",$J,"E",IBADDN,IBX,IBPTNM,IBDFN)) Q:IBDFN="" I $D(^TMP("IBEMP",$J,IBDFN)) D:(IBLN+3)>IOSL HDR Q:IBQ D
- .... S IBPAT=^TMP("IBEMP",$J,IBDFN),IBLN=IBLN+2 S Y=$P(IBPAT,"^",3) X ^DD("DD")
- .... W !!,?3,"Patient: ",?12,$P(IBPAT,"^",1),?55,$P(IBPAT,"^",2),?70,$P(IBPAT,"^",5),?77,Y,?92,$E($P(IBPAT,"^",4),1,11),?107,"Home: ",$P($G(^DPT(IBDFN,.13)),"^",1)
- .... ;
- .... ;print employed's data
- .... S IBZ="" F S IBZ=$O(^TMP("IBEMP",$J,"E",IBADDN,IBX,IBPTNM,IBDFN,IBZ)) Q:IBZ="" D:(IBLN'<IOSL) HDR Q:IBQ D
- ..... S IBEMPED=^TMP("IBEMP",$J,IBDFN,IBZ),IBLN=IBLN+1
- ..... W !,?3,"Employed: ",?13,$S(IBZ="P":"Patient: ",1:"Spouse: "),?22,$P(IBEMPED,"^",1),?55,$P(IBEMPED,"^",4),?70,$E($P(IBEMPED,"^",2),1,19),?92,$E($P(IBEMPED,"^",3),1,11)
- ..... I IBZ="P" W ?107,"Work: ",$P($G(^DPT(IBDFN,.13)),"^",2) ; we only have patients work number
- I 'IBQ D PAUSE
- K IBT,IBE,IBP,IBI,IBY,IBX,IBZ,IBQ,IBW,IBCNT,IBADD,IBADDN,IBLNG,IBDFN,IBPAT,IBPTNM,IBEMPED,X,Y
- Q
- ;
- HDR ;print the report header, allow user stops, for terminals only form feed on first page
- S IBQ=$$STOP Q:IBQ D:IBPGN>0 PAUSE Q:IBQ I IBPGN>0!($E(IOST,1,2)["C-") W @IOF
- S IBPGN=IBPGN+1,IBLN=5 W IBHDR,IBBEGE," - ",IBENDE I IOM<85 W !
- W ?(IOM-30),IBCDT,?(IOM-8),"PAGE ",IBPGN W:IBHDR'="" !,IBHDR1 W !,IBDSH,!
- Q
- ;
- PAUSE ;pause at end of screen if being displayed on a terminal
- Q:$E(IOST,1,2)'["C-"
- S DIR(0)="E" D ^DIR K DIR I $D(DUOUT)!($D(DIRUT)) S IBQ=1
- Q
- ;
- STOP() ;determine if user requested task to be stopped
- I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !!,"TASK STOPPED BY USER",!!
- Q +$G(ZTSTOP)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBOEMP2 3142 printed Feb 18, 2025@23:51:59 Page 2
- IBOEMP2 ;ALB/ARH - EMPLOYER REPORT (PRINT) ; 6/19/93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;
- +3 ;Array: patient: DFN)=pt name ^ SSN ^ event date ^ appt type ^ prim elig
- +4 ; employed: DFN,x)=name ^ occupation ^ employment status ^ SSN
- +5 ; employer: "E",EMPLOYER NAME)=count of employees per employer name
- +6 ; "E",EMPLOYER NAME,y)=employer address
- +7 ; "E",EMPLOYER NAME,y,PATIENT NAME,DFN,x)=""
- +8 ;
- +9 ; w/x = "P" if employed is patient, "S" for spouse otherwise
- +10 ; y = number of employers with same name but not the same address, ie. 1:1:...
- +11 ;
- +12 ;
- +13 DO HDR
- +14 ;
- P1 ;print report
- +1 if '$DATA(^TMP("IBEMP",$JOB))
- QUIT
- SET IBW=IOM
- +2 SET IBADDN=""
- FOR
- SET IBADDN=$ORDER(^TMP("IBEMP",$JOB,"E",IBADDN))
- if IBADDN=""!(IBQ)
- QUIT
- SET IBCNT=^TMP("IBEMP",$JOB,"E",IBADDN)
- SET IBX=""
- Begin DoDot:1
- +3 FOR
- SET IBX=$ORDER(^TMP("IBEMP",$JOB,"E",IBADDN,IBX))
- if IBX=""!(IBQ)
- QUIT
- if (IBLN+9)>IOSL
- DO HDR
- if IBQ
- QUIT
- Begin DoDot:2
- +4 ;
- +5 ;print employer name and address
- +6 SET IBADD=^TMP("IBEMP",$JOB,"E",IBADDN,IBX)
- WRITE !,$EXTRACT($PIECE(IBADD,"^",1),1,29),?32,$PIECE(IBADD,"^",8),?55
- SET IBLNG=55
- SET IBLN=IBLN+2
- +7 FOR IBI=2:1:7
- SET IBP=$PIECE(IBADD,"^",IBI)
- IF IBP'=""
- SET IBP=IBP_$SELECT(IBI<6:",",IBI=6:" ",1:"")
- Begin DoDot:3
- +8 FOR
- SET IBE=$PIECE(IBP," ",1)_" "
- SET IBP=$PIECE(IBP," ",2,999)
- Begin DoDot:4
- +9 SET IBT=$LENGTH(IBE)
- IF (IBT+IBLNG)>IOM
- SET IBLNG=55
- SET IBLN=IBLN+1
- WRITE !
- End DoDot:4
- WRITE ?IBLNG,IBE
- SET IBLNG=IBLNG+IBT
- if IBP=""
- QUIT
- End DoDot:3
- +10 ;
- +11 ;print patient data
- +12 SET IBPTNM=""
- FOR
- SET IBPTNM=$ORDER(^TMP("IBEMP",$JOB,"E",IBADDN,IBX,IBPTNM))
- if IBPTNM=""
- QUIT
- Begin DoDot:3
- +13 SET IBDFN=""
- FOR
- SET IBDFN=$ORDER(^TMP("IBEMP",$JOB,"E",IBADDN,IBX,IBPTNM,IBDFN))
- if IBDFN=""
- QUIT
- IF $DATA(^TMP("IBEMP",$JOB,IBDFN))
- if (IBLN+3)>IOSL
- DO HDR
- if IBQ
- QUIT
- Begin DoDot:4
- +14 SET IBPAT=^TMP("IBEMP",$JOB,IBDFN)
- SET IBLN=IBLN+2
- SET Y=$PIECE(IBPAT,"^",3)
- XECUTE ^DD("DD")
- +15 WRITE !!,?3,"Patient: ",?12,$PIECE(IBPAT,"^",1),?55,$PIECE(IBPAT,"^",2),?70,$PIECE(IBPAT,"^",5),?77,Y,?92,$EXTRACT($PIECE(IBPAT,"^",4),1,11),?107,"Home: ",$PIECE($GET(^DPT(IBDFN,.13)),"^",1)
- +16 ;
- +17 ;print employed's data
- +18 SET IBZ=""
- FOR
- SET IBZ=$ORDER(^TMP("IBEMP",$JOB,"E",IBADDN,IBX,IBPTNM,IBDFN,IBZ))
- if IBZ=""
- QUIT
- if (IBLN'<IOSL)
- DO HDR
- if IBQ
- QUIT
- Begin DoDot:5
- +19 SET IBEMPED=^TMP("IBEMP",$JOB,IBDFN,IBZ)
- SET IBLN=IBLN+1
- +20 WRITE !,?3,"Employed: ",?13,$SELECT(IBZ="P":"Patient: ",1:"Spouse: "),?22,$PIECE(IBEMPED,"^",1),?55,$PIECE(IBEMPED,"^",4),?70,$EXTRACT($PIECE(IBEMPED,"^",2),1,19),?92,$EXTRACT($PIECE(IBEMPED,"^",3),1
- ,11)
- +21 ; we only have patients work number
- IF IBZ="P"
- WRITE ?107,"Work: ",$PIECE($GET(^DPT(IBDFN,.13)),"^",2)
- End DoDot:5
- End DoDot:4
- End DoDot:3
- if IBQ
- QUIT
- End DoDot:2
- WRITE !!,IBDSH,!
- SET IBLN=IBLN+2
- End DoDot:1
- if IBQ
- QUIT
- +22 IF 'IBQ
- DO PAUSE
- +23 KILL IBT,IBE,IBP,IBI,IBY,IBX,IBZ,IBQ,IBW,IBCNT,IBADD,IBADDN,IBLNG,IBDFN,IBPAT,IBPTNM,IBEMPED,X,Y
- +24 QUIT
- +25 ;
- HDR ;print the report header, allow user stops, for terminals only form feed on first page
- +1 SET IBQ=$$STOP
- if IBQ
- QUIT
- if IBPGN>0
- DO PAUSE
- if IBQ
- QUIT
- IF IBPGN>0!($EXTRACT(IOST,1,2)["C-")
- WRITE @IOF
- +2 SET IBPGN=IBPGN+1
- SET IBLN=5
- WRITE IBHDR,IBBEGE," - ",IBENDE
- IF IOM<85
- WRITE !
- +3 WRITE ?(IOM-30),IBCDT,?(IOM-8),"PAGE ",IBPGN
- if IBHDR'=""
- WRITE !,IBHDR1
- WRITE !,IBDSH,!
- +4 QUIT
- +5 ;
- PAUSE ;pause at end of screen if being displayed on a terminal
- +1 if $EXTRACT(IOST,1,2)'["C-"
- QUIT
- +2 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)!($DATA(DIRUT))
- SET IBQ=1
- +3 QUIT
- +4 ;
- STOP() ;determine if user requested task to be stopped
- +1 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET ZTSTOP=1
- KILL ZTREQ
- IF +$GET(IBPGN)
- WRITE !!,"TASK STOPPED BY USER",!!
- +2 QUIT +$GET(ZTSTOP)
