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