| 1 | DGEEREIM ;ALB/BRM;Reimbursable Primary Eligibility Code Report ; 5/23/05 11:04am
|
|---|
| 2 | ;;5.3;Registration;**672,706**;Aug 13,1993
|
|---|
| 3 | ;;
|
|---|
| 4 | ; This routine will identify and report any veteran who has a
|
|---|
| 5 | ; Reimbursable Insurance Primary Eligibility Code and who is not
|
|---|
| 6 | ; deceased.
|
|---|
| 7 | ;
|
|---|
| 8 | QUETASK ; Queue the DMZ/Reimbursable Stats job
|
|---|
| 9 | N TXT,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTDTH,POP,IO,IOBS,IOF,IOHG,IOM,ION,IOPAR
|
|---|
| 10 | N IOS,IOSL,IOST,IOT,IOUPAR,IOXY,%ZIS,ZTSAVE
|
|---|
| 11 | K ^TMP($J,"DGEEREIM")
|
|---|
| 12 | S %ZIS="QM" D ^%ZIS I $G(POP) W !,"Job Terminated!" Q
|
|---|
| 13 | I $D(IO("Q")) D Q
|
|---|
| 14 | .S ZTRTN="LOOP^DGEEREIM",ZTDTH=$$NOW^XLFDT()
|
|---|
| 15 | .S ZTDESC="REIMBURSABLE INSURANCE PRIMARY ELIG CODE JOB"
|
|---|
| 16 | .D ^%ZTLOAD
|
|---|
| 17 | .S TXT=$S($G(ZTSK):"Task: "_ZTSK_" Queued.",1:"Error: Process not queued!")
|
|---|
| 18 | .D HOME^%ZIS
|
|---|
| 19 | .W !,TXT
|
|---|
| 20 | ;
|
|---|
| 21 | LOOP ; entry point
|
|---|
| 22 | N QFLG,DFN,ELIG,QUIT,RCNT,RDT,ZZ
|
|---|
| 23 | N X,X1,X2,EC81,PRIMEC,%,CRT,DATA,DIRUT,EC8,LINE,NAME,PAGE
|
|---|
| 24 | ; get local codes assigned to the national Reimbursible code
|
|---|
| 25 | S EC8=$O(^DIC(8.1,"B","REIMBURSABLE INSURANCE",""))
|
|---|
| 26 | S EC81=""
|
|---|
| 27 | F S EC81=$O(^DIC(8,"D",EC8,EC81)) Q:'EC81 S ELIG(EC81)=""
|
|---|
| 28 | ; loop through patient records
|
|---|
| 29 | S DFN=0
|
|---|
| 30 | F S DFN=$O(^DPT(DFN)) Q:'DFN D
|
|---|
| 31 | .; quit if deceased
|
|---|
| 32 | .Q:$P($G(^DPT(DFN,.35)),"^")
|
|---|
| 33 | .;check for Primary EC of Reimbursable Insurance
|
|---|
| 34 | .S PRIMEC=$P($G(^DPT(DFN,.36)),"^"),EC81="",QFLG=0
|
|---|
| 35 | .F S EC81=$O(ELIG(EC81)) Q:(QFLG!'EC81) D
|
|---|
| 36 | ..Q:PRIMEC'=EC81
|
|---|
| 37 | ..S ^TMP($J,"DGEEREIM","RCNT")=$G(^TMP($J,"DGEEREIM","RCNT"))+1,QFLG=1
|
|---|
| 38 | ..S SSN=$P($G(^DPT(DFN,0)),"^",9),NAME=$P($G(^DPT(DFN,0)),"^")
|
|---|
| 39 | ..S ^TMP($J,"DGEEREIM","DATA",SSN)=NAME_"^"_$$EXTERNAL^DILFD(2,.361,"",PRIMEC)
|
|---|
| 40 | U IO
|
|---|
| 41 | D PSET,REPORT
|
|---|
| 42 | D ^%ZISC,HOME^%ZIS
|
|---|
| 43 | Q
|
|---|
| 44 | PSET ; set up printer variables
|
|---|
| 45 | N ZZ
|
|---|
| 46 | S CRT=$S($E(IOST,1,2)="C-":1,1:0)
|
|---|
| 47 | S (RDT,Y)=""
|
|---|
| 48 | F ZZ=1:1:IOM S $P(LINE,"-",ZZ)=""
|
|---|
| 49 | D NOW^%DTC S Y=% X ^DD("DD")
|
|---|
| 50 | S RDT=$P(Y,"@",1)_" @ "_$P($P(Y,"@",2),":",1,2)
|
|---|
| 51 | S RCNT=+$G(^TMP($J,"DGEEREIM","RCNT"))
|
|---|
| 52 | Q
|
|---|
| 53 | HDR ; Report Header
|
|---|
| 54 | W !,?((IOM-40)\2),"Reimbursable Insurance Primary EC Report"
|
|---|
| 55 | W !,?((IOM-22-$L(RDT))\2),"Date/Time Report Run: ",RDT
|
|---|
| 56 | W !!,?((IOM-35-$L(RCNT))\2),"Total Patients with RI Primary EC: ",RCNT
|
|---|
| 57 | W !,LINE
|
|---|
| 58 | W !!,?5,"SSN",?17,"NAME",?50,"PRIMARY ELIG. CODE"
|
|---|
| 59 | W !,?5,"---------",?17,"------------------------------"
|
|---|
| 60 | W ?50,"-------------------"
|
|---|
| 61 | Q
|
|---|
| 62 | REPORT ;report results
|
|---|
| 63 | N SSN
|
|---|
| 64 | I CRT,+$G(PAGE)=0 W @IOF
|
|---|
| 65 | S PAGE=1 D HDR
|
|---|
| 66 | S SSN="" F S SSN=$O(^TMP($J,"DGEEREIM","DATA",SSN)) Q:SSN']""!($G(QUIT)) D
|
|---|
| 67 | .S DATA=$G(^TMP($J,"DGEEREIM","DATA",SSN))
|
|---|
| 68 | .I $Y>(IOSL-5) W:'$G(CRT) !,?68,"Page: "_PAGE D:$G(CRT) PAUSE Q:$G(QUIT) W @IOF D HDR S PAGE=PAGE+1
|
|---|
| 69 | .W !?5,SSN,?17,$P(DATA,"^"),?50,$P(DATA,"^",2)
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | PAUSE ; Screen pause. Sets QUIT=1 if user decides to quit.
|
|---|
| 73 | N DIR,X,Y
|
|---|
| 74 | F Q:$Y>(IOSL-5) W !
|
|---|
| 75 | W !,?68,"Page: "_PAGE,!
|
|---|
| 76 | S DIR(0)="E" D ^DIR I ('(+Y))!$D(DIRUT) S QUIT=1
|
|---|
| 77 | Q
|
|---|
