source: FOIAVistA/tag/r/FEE_BASIS-FB/FBPST35.m@ 628

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