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

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

initial load of WorldVistAEHR
File size: 4.1 KB
Line 
1IBYHPT ;ALB/TMP - PATCH IB*2*43 POST-INITIALIZATION ; 21-AUG-95
2 ;;Version 2.0 ; INTEGRATED BILLING ;**43**; 21-MAR-94
3 ;
4EN D DEL ;Delete items moved in IBCNSC INSURANCE CO and IBCNSP POLICY MENU
5 D ^IBYHONIT ;Install protocols
6 D BLD ;update ^XUTL("XQORM" for menu protocols
7 D TEM ;Install list templates
8 D RIDERS ;Add records to file 355.6
9 D CATUPD ;Update 355.31 with RIDER file entries just added
10 Q
11 ;
12DEL ;Delete items moved from item multiples of
13 ; IBCNSC INSURANCE COMPANY and IBCNSP POLICY MENU
14 S DIC(0)="F",DIC="^ORD(101,",X="IBCNSC INSURANCE CO"
15 D ^DIC K DIC
16 I Y>0 S IBMENU=+Y D
17 .S DIC(0)="F",DIC="^ORD(101,"_IBMENU_",10,"
18 .S X="IBCNS QUIT" D ^DIC I Y>0 S DA(1)=IBMENU,DA=+Y D DEL1(.DA,X,IBMENU)
19 .K DIC,DA
20 S DIC(0)="F",DIC="^ORD(101,",X="IBCNSP POLICY MENU"
21 D ^DIC K DIC
22 I Y>0 S IBMENU=+Y D
23 .S DIC(0)="F",DIC="^ORD(101,"_IBMENU_",10,"
24 .F X="IBCNSP ADD COMMENT","IBCNSP EDIT ALL","IBCNSJ CHANGE PLAN" D ^DIC I Y>0 S DA=+Y,DA(1)=IBMENU D DEL1(.DA,X,IBMENU)
25 .K DIC,DA
26 K DIK,DA,IBMENU
27 Q
28 ;
29DEL1(DA,X,IBMENU) ; delete protocol menu item
30 W !!,">>> Deleting protocol ",X," as an item of ",$P($G(^ORD(101,IBMENU,0)),U)," ...",!," (It will be re-added in a moment)"
31 S DIK="^ORD(101,"_IBMENU_",10," D ^DIK
32 K DIK
33 Q
34 ;
35BLD ; Update ^XUTL("XQORM" for menu protocols
36 W !
37 F IBX="IBCNSC PLAN LIST","IBCNSC PLAN DETAIL","IBCNSC INSURANCE CO","IBCNSP POLICY MENU" D
38 .S DIC="^ORD(101,",DIC(0)="F",X=IBX D ^DIC K DIC
39 .Q:Y<0
40 .W !,">>> Rebuilding ^XUTL for protocol '",IBX,"' ..."
41 .S XQORM=+Y_";ORD(101," D XREF^XQORM
42 K ORULT,XQORM,X,Y,IBX
43 Q
44 ;
45RIDERS ; Add records to INSURANCE RIDERS file for new limitation categories
46 W !,">>> Adding records to INSURANCE RIDERS file for new limitation categories..."
47 F X="INPATIENT COVERAGE","OUTPATIENT COVERAGE","PRESCRIPTION COVERAGE" I '$D(^IBE(355.6,"B",X)) S DIC(0)="L",DIC="^IBE(355.6," D ^DIC
48 W "Done."
49 K DIC
50 Q
51 ;
52CATUPD ; Update PLAN LIMITATION CATEGORY file insurance rider info
53 W !,">>> Updating PLAN LIMITATION CATEGORY file with insurance rider info..."
54 N DA,CAT
55 S DA=0 F S DA=$O(^IBE(355.31,DA)) Q:'DA S CAT=$G(^(DA,0)) I $P(CAT,U,3)="" S DIE="^IBE(355.31,",DR=".03///^S X="""_$S($P(CAT,U)'="PHARMACY":$P(CAT,U),1:"PRESCRIPTION")_" COVERAGE""" D ^DIE
56 W "Done."
57 Q
58 ;
59TEM ; Install list templates
60 W !,">>> Installing List Templates..."
61 W !,"'IBCNS INS CO PLAN DETAIL' List Template ..."
62 S DA=$O(^SD(409.61,"B","IBCNS INS CO PLAN DETAIL",0)),DIK="^SD(409.61," D ^DIK:DA
63 K DO,DD S DIC="^SD(409.61,",DIC(0)="L",X="IBCNS INS CO PLAN DETAIL" D FILE^DICN S VALM=+Y
64 I VALM>0 D
65 .S ^SD(409.61,VALM,0)="IBCNS INS CO PLAN DETAIL^1^^80^5^17^1^1^Plan^IBCNSC PLAN DETAIL^View/Edit Plan"
66 .S ^SD(409.61,VALM,1)="^VALM HIDDEN ACTIONS"
67 .S ^SD(409.61,VALM,"ARRAY")=" ^TMP(""IBCNSCP"",$J)"
68 .S ^SD(409.61,VALM,"FNL")="D EXIT^IBCNSC41"
69 .S ^SD(409.61,VALM,"HDR")="D HDR^IBCNSC41"
70 .S ^SD(409.61,VALM,"HLP")="D HELP^IBCNSC41"
71 .S ^SD(409.61,VALM,"INIT")="D INIT^IBCNSC4"
72 .S DA=VALM,DIK="^SD(409.61," D IX1^DIK K DA,DIK
73 .W "Filed."
74 ;
75 W !,"'IBCNS PLAN LIST' List Template ..."
76 S DA=$O(^SD(409.61,"B","IBCNS PLAN LIST",0)),DIK="^SD(409.61," D ^DIK:DA
77 K DO,DD S DIC(0)="^SD(409.61,",X="IBCNS PLAN LIST" D FILE^DICN S VALM=+Y
78 I VALM>0 D
79 .S ^SD(409.61,VALM,0)="IBCNS PLAN LIST^1^^80^6^19^1^1^Plan^IBCNSC PLAN LIST^Insurance Plan List^1^^1"
80 .S ^SD(409.61,VALM,1)="^VALM HIDDEN ACTIONS"
81 .S ^SD(409.61,VALM,"ARRAY")=" ^TMP(""IBCNSJ"",$J)"
82 .S ^SD(409.61,VALM,"COL",0)="^409.621^8^8"
83 .S ^SD(409.61,VALM,"COL",1,0)="NUMBER^1^4^"
84 .S ^SD(409.61,VALM,"COL",2,0)="GNAME^5^18^Group Name"
85 .S ^SD(409.61,VALM,"COL",3,0)="GNUM^25^17^Group Number"
86 .S ^SD(409.61,VALM,"COL",4,0)="TYPE^44^13^Type of Plan"
87 .S ^SD(409.61,VALM,"COL",5,0)="UR^59^3^UR?"
88 .S ^SD(409.61,VALM,"COL",6,0)="PREC^64^3^Ct?"
89 .S ^SD(409.61,VALM,"COL",7,0)="PREEX^70^4^ExC?"
90 .S ^SD(409.61,VALM,"COL",8,0)="BENAS^76^3^As?"
91 .S ^SD(409.61,VALM,"FNL")="D FNL^IBCNSU2"
92 .S ^SD(409.61,VALM,"HDR")="D HDR^IBCNSC4"
93 .S ^SD(409.61,VALM,"HLP")="S X=""?"" D DISP^XQORM1 W !!"
94 .S ^SD(409.61,VALM,"INIT")="D INIT^IBCNSU2"
95 .S DA=VALM,DIK="^SD(409.61," D IX1^DIK K DA,DIK
96 .W "Filed."
97 ;
98 W "Done."
99 ;
100 K DIC,DIK,DIE,VALM,X,DA,DR
101 Q
102 ;
Note: See TracBrowser for help on using the repository browser.