source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBPST35.m

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

initial load of WorldVistAEHR

File size: 4.7 KB
Line 
1FBPST35 ;AISC/DMK-UPDATE POV FILE ;4/6/93 14:10
2 ;;3.5;FEE BASIS;;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4ENPOV ;go through POV file and inactivate any duplicates
5 W !,"Starting Post Init FBPST35 " D NOW^%DTC W $$DATX^FBAAUTL(%)
6 S (FBI,FBJ,FBHI)=0
7 F S FBI=$O(^FBAA(161.82,"C",FBI)) Q:'FBI F S FBJ=$O(^FBAA(161.82,"C",FBI,FBJ)) Q:'FBJ D
8 .I $G(FBHI)=FBI S DIE="^FBAA(161.82,",DR="4////^S X="_DT,DA=FBJ D ^DIE
9 .S FBHI=FBI
10 K FBI,FBJ,FBHI,DIE,DR
11 ;
12 ;set new entries into ^TMP
13 F I=1:1 S II=$P($T(POV+I),";;",2) Q:II="" D
14 .S ^TMP($J,"FB",II)=$P($T(POV+I),";;",3)
15 ;
16 ;update file 161.82
17 S (FBI,FBJ)=0
18 F S FBI=$O(^FBAA(161.82,"C",FBI)) Q:'FBI F S FBJ=$O(^FBAA(161.82,"C",FBI,FBJ)) Q:'FBJ D:'$P($G(^FBAA(161.82,FBJ,"I")),"^")
19 .I $P($G(^FBAA(161.82,FBJ,0)),"^")'=$P($G(^TMP($J,"FB",FBI)),"^") S $P(^FBAA(161.82,FBJ,0),"^")=$P(^TMP($J,"FB",FBI),"^")
20 ;
21 N FBX S DIC="^FBAA(161.82,",DIC(0)="L",DLAYGO=161.82
22 F FBI="02",37,38,77,78 I '$D(^FBAA(161.82,"C",FBI)) D
23 .S FBX=$G(^TMP($J,"FB",FBI)),X=$P(FBX,U)
24 .S DIC("DR")="3////"_FBI S:+$P(FBX,U,2) DIC("DR")=DIC("DR")_";2////^S X="_$P(FBX,U,2)
25 .K DD,DO D FILE^DICN
26 K DIC,DLAYGO
27 ;
28 K ^FBAA(161.82,"B") S DIK="^FBAA(161.82,",DIK(1)=".01" D ENALL^DIK K DIK
29 K ^FBAA(161.82,"AC") S DIK="^FBAA(161.82,",DIK(1)="3^AC" D ENALL^DIK K DIK
30 K DIC,DIE,DR,I,II,FBI,FBJ,DIK,^TMP($J,"FB"),X,Y
31 ;
32IX1 ;clean up old x-ref no longer used
33 K ^FBAAC("AD","R")
34 K ^DD(162.03,18,1,1),^DD(162,0,"IX","AE",162.03,18)
35 K ^DD(162.7,0,"IX","ADT",162.7,10),^DD(162.7,0,"IX","AST",162.7,24)
36 K ^DD(161,0,"IX","C",161.01,1)
37 K ^FBAAC("AF"),^DD(162.03,19,1,1),^DD(162,0,"IX","AF",162.03,19)
38 ;
39LOCK ;remove the FBAASUPERVISOR lock from option
40 ;
41 N FBI,FBJ,DIC,DIE,DR,DA
42 S FBJ=1
43 F S FBI=$P($T(OPT+FBJ),";;",2) Q:FBI="END" S FBJ=FBJ+1 D
44 . S DIC="^DIC(19,",X=FBI,DIC(0)="QZ" D ^DIC Q:Y<0 D:$P(Y(0),U,6)="FBAASUPERVISOR"
45 ..S DIE=DIC,DA=+Y,DR="3///@" D ^DIE
46 ;
47 ;populate new transmission header field stored in 161.4
48 I $D(^FBAA(161.4,1,0)) S $P(^(1),U,10)="FEN",$P(^(1),U,9)=125
49 W !,"Completed FBPST35 " D NOW^%DTC W $$DATX^FBAAUTL(%)
50 D ^FBPST35A
51 D ^FBPST35B
52 D ^FBPST35C
53 D VENDOR^FBPST35B
54 D XREF^FBPST35B
55 D ^FBONIT ;to create protocols for list manager phone inq menu
56 D ^FBP35D ; to create list template for phone inq menu
57 S X="FBINITY" X ^%ZOSF("TEST") I $T D @("^"_X)
58 Q
59 ;
60OPT ;options to update
61 ;;FBAA REJECT PRINT
62 ;;FBAA OBSOLETE ID CARDS
63 ;;FBAA ID CARDS CURRENT LIST
64 ;;FBCH PRICER RELEASE
65 ;;FBCNH POST COMMITMENTS
66 ;;END
67 ;
68POV ;
69 ;;02;;UNAUTHORIZED CLAIM - OUTPATIENT
70 ;;10;;OPT - SC 50% OR MORE
71 ;;11;;OPT TO OBVIATE THE NEED FOR HOSP. ADMISSION
72 ;;12;;CHAMPVA SPONSOR
73 ;;13;;CHAMPVA BENEFICIARY
74 ;;15;;CLASS I DENTAL TREATMENT
75 ;;16;;CLASS II DENTAL TREATMENT
76 ;;17;;CLASS IIa DENTAL TREATMENT
77 ;;18;;CLASS IIb DENTAL TREATMENT
78 ;;19;;CLASS IIc DENTAL TREATMENT
79 ;;20;;CLASS IIr DENTAL TREATMENT
80 ;;21;;CLASS III DENTAL TREATMENT
81 ;;22;;CLASS IV DENTAL TREATMENT
82 ;;23;;CLASS V DENTAL TREATMENT
83 ;;24;;CLASS VI DENTAL TREATMENT
84 ;;30;;AUTHORIZED NON-VA HOSPITAL CARE FOR SC COND.
85 ;;31;;UNAUTHORIZED NON-VA HOSPITAL CARE, SC OR NSC COND
86 ;;32;;EMERG. NON-VA CARE (INPT/OPT) FOR VET. REC. INPT. CARE IN VAMC
87 ;;33;;EMERG. NON-VA CARE (INPT/OPT) VET. REC. CARE IN FED. HOSP. AT VA EXP.
88 ;;34;;NON-VA HOSP. CARE FOR WOMEN VETERANS (NO OTHER ELIGIBILITY)
89 ;;35;;NON-VA HOSP. CARE FOR NSC COND. (AK, VI AND HI ONLY)
90 ;;36;;NON-VA HOSP. CARE FOR VET. REC. INPT. CARE IN FED. HOSP. AT VA EXP.
91 ;;37;;HOSPICE CARE (INPT.) CONTRACT/SHARING AGREEMENT^6
92 ;;38;;HOSPICE CARE (INPT.) FEE BASIS AUTHORITY (CFR 17.50b)^6
93 ;;40;;COMMUNITY NURSING HOME FOR SC DISABILITY(IES)
94 ;;41;;COMMUNITY NURSING HOME FOR NSC DISABILITY(IES)
95 ;;42;;COMMUNITY NURSING HOME FOR ACTIVE DUTY PERSONNEL
96 ;;50;;CONTRACT READJUSTMENT COUNSELING AND RELATED MENTAL HEALTH SERVICES
97 ;;60;;CONTRACT HALFWAY HOUSE SUBSTANCE ABUSE REHABILITATION OR TREATMENT
98 ;;70;;HOME HEALTH NURSING SERVICES
99 ;;71;;HOME HEALTH SERVICES (NON-NURSE)
100 ;;72;;HISA - NSC
101 ;;73;;HISA - SC
102 ;;77;;HOSPICE CARE (OPT) - CONTRACT/SHARING AGREEMENT^2
103 ;;78;;HOSPICE CARE (OPT) - FEE BASIS AUTHORITY (CFR 17.50b)^2
104 ;;80;;OPT DIAGNOSTIC SVC. OBTAINED BY INDP. CLINIC TO OBVIATE HOSP. CARE
105 ;;81;;DIAGNOSTIC SVC. FOR VET IN MED. CENTER OPT PROGRAM[5~
106 ;;82;;FEE OXYGEN
107 ;;83;;OPT SERVICES FOR VA INPATIENTS
108 ;;84;;SUPPLEMENTAL DIAGNOSTIC SERVICES - TREATMENT/ALLERGY CLINICS
109 ;;85;;OPT SERVICES FOR VA OUTPATIENTS
110 ;;01;;COMPENSATION AND PENSION EXAM
111 ;;03;;APPLICATION FOR MED. BENEFITS (VAF 10-10)
112 ;;04;;VA INSURANCE EXAM
113 ;;05;;OPT SERVICES/TREATMENT FOR NSC DISABILITIES
114 ;;06;;OPT FOR VETS. IN RECEIPT OF AID & ATTENDANCE OR HOUSEBOUND BENEFITS
115 ;;07;;MISC. (ELIG. UNDER VOC. REHAB, OTHER FED. AGENCY OR ALLIED BENE.)
116 ;;08;;OPT WORLD WAR I AND MEXICAN BORDER PERIOD
117 ;;09;;OPT - SC LESS THAN 50%
118 Q
Note: See TracBrowser for help on using the repository browser.