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

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1IBCNSC2 ;ALB/NLR - INACTIVATE AND REPOINT INS STUFF ; 20-APR-93
2 ;;Version 2.0 ; INTEGRATED BILLING ;**28**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5MAIN ; -- main flow control
6 ;
7 S IBQUIT=0
8 D START I IBQUIT G MAINQ
9 D AP I IBQUIT G MAINQ
10 I +IBV=1 D RPTASK^IBCNSC3
11MAINQ K DFN,DIRUT,DIROUT,DTOUT,DUOUT,IBC,IBCOV,IBV,IBVER,IBV1,IBN,IBQUIT
12 Q
13 ;
14 ;
15START ; -- activate or inactivate insurance co. if necessary
16 ;
17 I $D(^IBT(356.2,"AIACT",IBCNS)) W !!,*7,"Please note that Insurance Reviews have been conducted with this company!!",!
18 S IBV=$P(^DIC(36,IBCNS,0),U,5),IBV1=IBV,IBN=$P(^DIC(36,IBCNS,0),U)
19 S IBA="ACTIVE",IBB="ACTIVATE",IBVER=0 I IBV S IBA="IN"_IBA
20 I 'IBV S IBB="IN"_IBB
21 S DIR("B")="No"
22 S DIR(0)="YO",DIR("A")=""_IBN_" IS CURRENTLY "_IBA_". DO YOU WISH TO "_IBB_" IT"
23 S DIR("?",1)="Company should be INACTIVE if it is no longer"
24 S DIR("?",2)="active in your area. This will disallow users"
25 S DIR("?")="from selecting this insurance company entry."
26 D ^DIR K DIR I $D(DIRUT) S IBQUIT=1 G STARTQ
27 I 'IBV,Y D VERIFY^IBCNSC3 G:IBQUIT STARTQ S IBVER=1
28 I 'IBVER,IBV,Y S IBV=0
29 ;
30 ; -- change global if ins. co. activated or inactivated
31 I IBV1'=IBV S $P(^DIC(36,IBCNS,0),U,5)=IBV,IBCOV=1
32 ;
33 ; -- display number of patients with coverage from selected company
34 S DFN=0,IBC=0 F S DFN=$O(^DPT("AB",IBCNS,DFN)) Q:'DFN!(IBC>20) S IBC=IBC+1
35 W !!,"THERE "_$S(IBC=0:"ARE NO PATIENTS",IBC=1:"IS ONE PATIENT",IBC>20:"ARE MORE THAN 20 PATIENTS",1:"ARE "_IBC_" PATIENTS")_" COVERED BY THIS "_$S(+IBV=0:"(ACTIVE)",1:"(INACTIVE)")_" INSURANCE COMPANY...."
36 I 'IBC D PAUSE^VALM1 S IBQUIT=1
37STARTQ K IBA,IBB
38 Q
39 ;
40AP ; -- ask if user wishes to print patients with inactivated insurance
41 ;
42 S DIR(0)="YO",DIR("A")="DO YOU WISH TO PRINT "_$S(IBC=1:"THE NAME OF THIS PATIENT",1:"A LIST OF ALL OF THE PATIENTS"),DIR("B")="No"
43 W ! D ^DIR K DIR I 'Y!$D(DIRUT) S:$D(DIRUT) IBQUIT=1 D:$G(IBCOV) COVD^IBCNSC3 G APQ
44 ;
45 ; -- ask for device
46 W !!,"*** You will need a 132 column printer for this report. ***",!
47 S %ZIS="QM" D ^%ZIS I POP S IBQUIT=1 D:$G(IBCOV) COVD^IBCNSC3 G APQ
48 I $D(IO("Q")) K IO("Q") S ZTRTN="PRINT^IBCNSC2",ZTSAVE("IB*")="",ZTDESC="PATIENTS WITH INACTIVATED INSURANCE" D ^%ZTLOAD K ZTSK D HOME^%ZIS Q
49 U IO
50 ;
51PRINT ; -- print list of patients covered by inactivated insurance company
52 ;
53 D BUILD^IBCNSC3
54 D HDR^IBCNSC3
55 S IBNA="" F S IBNA=$O(^TMP($J,"IBCNSC2",IBNA)) Q:IBNA=""!(IBQUIT) S DFN=0 F S DFN=$O(^TMP($J,"IBCNSC2",IBNA,DFN)) Q:'DFN!(IBQUIT) S IBD=0 F S IBD=$O(^TMP($J,"IBCNSC2",IBNA,DFN,IBD)) Q:'IBD!(IBQUIT) D
56 .S IBST=^TMP($J,"IBCNSC2",IBNA,DFN,IBD)
57 .I $Y>(IOSL-5) D PAUSE^IBOUTL D HDR^IBCNSC3
58 .W !,?1,$E(IBNA,1,28),?31,$P(IBST,"^",1),?46,$P(IBST,"^",2),?52,$$DAT1^IBOUTL($P(IBST,"^",3)),?63,$$DAT1^IBOUTL($P(IBST,"^",4)),?74,$P(IBST,"^",5),?95,$$EXPAND^IBTRE(2.312,6,$P(IBST,"^",6)),?106,$E($P(IBST,"^",7),1,24)
59 I $E(IOST,1,2)["C-",('($G(IBV))) D PAUSE^VALM1
60 K ^TMP($J,"IBCNSC2")
61 ;
62APQ I $D(ZTQUEUED) S ZTREQ="@" Q
63 D ^%ZISC
64 K IBPAG,IBNA,IBNO,IBIND,IBWI,VAOA,VA,VAERR
65 Q
Note: See TracBrowser for help on using the repository browser.