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

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

initial load of WorldVistAEHR
File size: 4.2 KB
Line 
1IBCNSU2 ;ALB/NLR - INSURANCE PLAN LOOK-UP UTILITY ; 18-NOV-94
2 ;;Version 2.0 ; INTEGRATED BILLING ;**28,62**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5LKP(IBCNS,IBIND,IBMULT,IBSEL,IBALR,IBW) ; Look-up Utility for Insurance Plans
6 ; Input: IBCNS -- Pointer to the ins. company in file #36
7 ; IBIND -- Include Individual Plans? (1 - Yes | 0 - No)
8 ; IBMULT -- If set to 1, allows multiple plans to be chosen
9 ; IBALR -- May be set to point to plan in file #355.3
10 ; to be excluded from selection
11 ; IBW -- If set to 1, allows inactive plans to be chosen
12 ; Output: IBSEL -- Set to the pointer to the plan in file #355.3
13 ; if only a single plan is to be selected.
14 ;
15 ; The array ^TMP($J,"IBSEL",ptr)="" is returned
16 ; (where 'ptr' points to the plan in file
17 ; #355.3) if multiple plans are to be selected.
18 ;
19 I '$G(IBCNS) G LKPQ
20 N VALMY,VALMHDR
21 S IBIND=$G(IBIND)>0,IBW=$G(IBW)>0,IBMULT=+$G(IBMULT),IBSEL=0
22 D EN^VALM("IBCNS PLAN LOOKUP")
23LKPQ Q
24 ;
25INIT ; Build the list of plans.
26 N IBP,IBCPOLD,X
27 K ^TMP("IBCNSJ",$J)
28 S VALMCNT=0,VALMBG=1
29 S IBP=0 F S IBP=$O(^IBA(355.3,"B",+IBCNS,IBP)) Q:'IBP D
30 .S IBCPOLD=$G(^IBA(355.3,+IBP,0))
31 .I 'IBIND,'$P(IBCPOLD,"^",2) Q ; exclude individual plans
32 .I 'IBW,$P(IBCPOLD,"^",11) Q ; plan is inactive
33 .;
34 .S VALMCNT=VALMCNT+1
35 .S X=$$SETFLD^VALM1(VALMCNT,"","NUMBER")
36 .I '$P(IBCPOLD,"^",2) S $E(X,4)="+"
37 .S X=$$SETFLD^VALM1($P(IBCPOLD,"^",3),X,"GNAME")
38 .I $P(IBCPOLD,"^",11) S $E(X,24)="*"
39 .S X=$$SETFLD^VALM1($P(IBCPOLD,"^",4),X,"GNUM")
40 .S X=$$SETFLD^VALM1($$EXPAND^IBTRE(355.3,.09,$P(IBCPOLD,"^",9)),X,"TYPE")
41 .S X=$$SETFLD^VALM1($$YN^IBCNSM($P(IBCPOLD,"^",5)),X,"UR")
42 .S X=$$SETFLD^VALM1($$YN^IBCNSM($P(IBCPOLD,"^",6)),X,"PREC")
43 .S X=$$SETFLD^VALM1($$YN^IBCNSM($P(IBCPOLD,"^",7)),X,"PREEX")
44 .S X=$$SETFLD^VALM1($$YN^IBCNSM($P(IBCPOLD,"^",8)),X,"BENAS")
45 .;
46 .S ^TMP("IBCNSJ",$J,VALMCNT,0)=X
47 .S ^TMP("IBCNSJ",$J,"IDX",VALMCNT,VALMCNT)=IBP
48 ;
49 I '$D(^TMP("IBCNSJ",$J)) S VALMCNT=2,^TMP("IBCNSJ",$J,1,0)=" ",^TMP("IBCNSJ",$J,2,0)=" No plans were identified for this company."
50 Q
51 ;
52HDR ; Build the list header.
53 N IBCNS0,IBCNS11,IBCNS13,IBLEAD,X,X1,X2
54 S IBCNS0=$G(^DIC(36,+IBCNS,0)),IBCNS11=$G(^(.11)),IBCNS13=$G(^(.13))
55 S X2=$S(IBW:"",1:"Active ")
56 S IBLEAD=$S(IBIND:"All "_X2,1:X2_"Group ")_"Plans for: "
57 S X="Phone: "_$S($P(IBCNS13,"^")]"":$P(IBCNS13,"^"),1:"<not filed>")
58 S VALMHDR(1)=$$SETSTR^VALM1(X,IBLEAD_$P(IBCNS0,"^"),81-$L(X),40)
59 S X1="Precerts: "_$S($P(IBCNS13,"^",3)]"":$P(IBCNS13,"^",3),1:"<not filed>")
60 S X=$TR($J("",$L(IBLEAD)),""," ")_$S($P(IBCNS11,"^")]"":$P(IBCNS11,"^"),1:"<no street address>")
61 S VALMHDR(2)=$$SETSTR^VALM1(X1,X,81-$L(X1),40)
62 S X=$S($P(IBCNS11,"^",4)]"":$P(IBCNS11,"^",4),1:"<no city>")_", "
63 S X=X_$S($P(IBCNS11,"^",5):$P($G(^DIC(5,$P(IBCNS11,"^",5),0)),"^",2),1:"<no state>")_" "_$E($P(IBCNS11,"^",6),1,5)_$S($E($P(IBCNS11,"^",6),6,9)]"":"-"_$E($P(IBCNS11,"^",6),6,9),1:"")
64 S VALMHDR(3)=$$SETSTR^VALM1(X,"",$L(IBLEAD)+1,80)
65 S X="#" I $G(IBIND) S X="# + => Indiv. Plan"
66 I $G(IBW) S X=$E(X_$J("",23),1,23)_"* => Inactive Plan"
67 S VALMHDR(4)=$$SETSTR^VALM1("Pre- Pre- Ben",X,64,17)
68 Q
69 ;
70FNL ; Exit action.
71 K ^TMP("IBCNSJ",$J),VALMBCK
72 D CLEAN^VALM10,CLEAR^VALM1
73 Q
74 ;
75SP ; 'Select Plan' Action
76 N DIR,DIRUT,DUOUT,DTOUT,DIROUT,IBOK,IBQUIT,IBX,Y
77 D EN^VALM2($G(XQORNOD(0)),"O"),FULL^VALM1
78 S IBX=$O(VALMY(0)),VALMBCK="R"
79 I 'IBX W !!,"No plan selected!" G SPQ
80 I 'IBMULT D G SPQ
81 .I $O(VALMY(IBX)) W !!,*7,"You may only select a single plan!" Q
82 .I $G(IBALR),+$G(^TMP("IBCNSJ",$J,"IDX",IBX,IBX))=IBALR W !!,*7,"This plan is not allowed for selection!" Q
83 .D OK^IBCNSM3
84 .I IBQUIT S VALMBCK="Q" Q
85 .I IBOK S IBSEL=+$G(^TMP("IBCNSJ",$J,"IDX",IBX,IBX)),VALMBCK="Q"
86 ;
87 S IBX=0 F S IBX=$O(VALMY(IBX)) Q:'IBX S ^TMP($J,"IBSEL",+$G(^TMP("IBCNSJ",$J,"IDX",IBX,IBX)))=""
88 S DIR(0)="Y",DIR("B")="NO",DIR("A")="Would you like to select any other plans"
89 S DIR("?")="If you wish to select plans from other screens, please answer 'YES'. Otherwise, answer 'NO'."
90 D ^DIR K DIR I Y<1!($D(DIRUT)) S VALMBCK="Q"
91 ;
92SPQ I '$O(IBSEL(0)),VALMBCK="R" D PAUSE^VALM1
93 Q
Note: See TracBrowser for help on using the repository browser.