source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBOEMP2.m@ 1073

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

initial load of WorldVistAEHR

File size: 3.0 KB
RevLine 
[613]1IBOEMP2 ;ALB/ARH - EMPLOYER REPORT (PRINT) ; 6/19/93
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;
4 ;Array: patient: DFN)=pt name ^ SSN ^ event date ^ appt type ^ prim elig
5 ; employed: DFN,x)=name ^ occupation ^ employment status ^ SSN
6 ; employer: "E",EMPLOYER NAME)=count of employees per employer name
7 ; "E",EMPLOYER NAME,y)=employer address
8 ; "E",EMPLOYER NAME,y,PATIENT NAME,DFN,x)=""
9 ;
10 ; w/x = "P" if employed is patient, "S" for spouse otherwise
11 ; y = number of employers with same name but not the same address, ie. 1:1:...
12 ;
13 ;
14 D HDR
15 ;
16P1 ;print report
17 Q:'$D(^TMP("IBEMP",$J)) S IBW=IOM
18 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
19 . 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
20 .. ;
21 .. ;print employer name and address
22 .. 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
23 .. F IBI=2:1:7 S IBP=$P(IBADD,"^",IBI) I IBP'="" S IBP=IBP_$S(IBI<6:",",IBI=6:" ",1:"") D
24 ... F S IBE=$P(IBP," ",1)_" ",IBP=$P(IBP," ",2,999) D W ?IBLNG,IBE S IBLNG=IBLNG+IBT Q:IBP=""
25 .... S IBT=$L(IBE) I (IBT+IBLNG)>IOM S IBLNG=55,IBLN=IBLN+1 W !
26 .. ;
27 .. ;print patient data
28 .. S IBPTNM="" F S IBPTNM=$O(^TMP("IBEMP",$J,"E",IBADDN,IBX,IBPTNM)) Q:IBPTNM="" D Q:IBQ
29 ... 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
30 .... S IBPAT=^TMP("IBEMP",$J,IBDFN),IBLN=IBLN+2 S Y=$P(IBPAT,"^",3) X ^DD("DD")
31 .... 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)
32 .... ;
33 .... ;print employed's data
34 .... S IBZ="" F S IBZ=$O(^TMP("IBEMP",$J,"E",IBADDN,IBX,IBPTNM,IBDFN,IBZ)) Q:IBZ="" D:(IBLN'<IOSL) HDR Q:IBQ D
35 ..... S IBEMPED=^TMP("IBEMP",$J,IBDFN,IBZ),IBLN=IBLN+1
36 ..... 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)
37 ..... I IBZ="P" W ?107,"Work: ",$P($G(^DPT(IBDFN,.13)),"^",2) ; we only have patients work number
38 I 'IBQ D PAUSE
39 K IBT,IBE,IBP,IBI,IBY,IBX,IBZ,IBQ,IBW,IBCNT,IBADD,IBADDN,IBLNG,IBDFN,IBPAT,IBPTNM,IBEMPED,X,Y
40 Q
41 ;
42HDR ;print the report header, allow user stops, for terminals only form feed on first page
43 S IBQ=$$STOP Q:IBQ D:IBPGN>0 PAUSE Q:IBQ I IBPGN>0!($E(IOST,1,2)["C-") W @IOF
44 S IBPGN=IBPGN+1,IBLN=5 W IBHDR,IBBEGE," - ",IBENDE I IOM<85 W !
45 W ?(IOM-30),IBCDT,?(IOM-8),"PAGE ",IBPGN W:IBHDR'="" !,IBHDR1 W !,IBDSH,!
46 Q
47 ;
48PAUSE ;pause at end of screen if being displayed on a terminal
49 Q:$E(IOST,1,2)'["C-"
50 S DIR(0)="E" D ^DIR K DIR I $D(DUOUT)!($D(DIRUT)) S IBQ=1
51 Q
52 ;
53STOP() ;determine if user requested task to be stopped
54 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ I +$G(IBPGN) W !!,"TASK STOPPED BY USER",!!
55 Q +$G(ZTSTOP)
Note: See TracBrowser for help on using the repository browser.