FBXIP48 ;WOIFO/SS-PATCH INSTALL ROUTINE ;6/29/01
;;3.5;FEE BASIS;**48**;JAN 30, 1995
Q
POST ;post-install entry point
D BMES^XPDUTL("Fee Basis LTC III, Post-Install Starting")
D SETLTC
D BMES^XPDUTL("Fee Basis LTC III, Post-Install Complet")
Q
;
LTCTYP(FBIENCL,FBLTCTYP) ;
N FBIENS,FBFDA,FBERR
S FBIENS=FBIENCL_"," ; "D0,"
S FBFDA(161.82,FBIENS,5)=FBLTCTYP ;status (file#,IENS,field#)
D FILE^DIE("","FBFDA","FBERR")
I $D(FBERR) D
. D BMES^XPDUTL(+$G(FBIENCL)_$G(FBLTCTYP)_" "_$G(FBERR("DIERR",1,"TEXT",1)))
Q
;
SETLTC ;
D BMES^XPDUTL(" Populating field #5 LTC COPAY TYPE of file #161.82")
N FBX,FBT,FBIEN
F FBX=1:1 S FBT=$P($T(POV+FBX),";",3) Q:'$L(FBT) D
. S FBIEN=+$O(^FBAA(161.82,"C",+FBT,0))
. I FBIEN=0 D BMES^XPDUTL(" Error: there is no entry for "_+FBT_" code in 161.82") Q
. D LTCTYP(FBIEN,$P(FBT,"^",2))
Q
;
;
; Listed below are the POV codes related to LTC
; 40,42,43,70,71,74 are exempt for all patients (;;2)
POV ;
;;41^1^COMMUNITY NURSING HOME FOR NSC DISABILITY(IES)
;;44^1^CNH RESPITE CARE
;;72^1^RESPITE CARE IN HOMEMAKER/HOME HEALTH AID SERVICES
;;73^1^RESPITE CARE IN ADHC
;;76^1^ADHC
;;79^1^RESPITE CARE (OTHER)
;;40^2^COMMUNITY NURSING HOME FOR SC DISABILITY(IES)
;;43^2^CNH HOSPICE
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBXIP48 1287 printed Dec 13, 2024@02:01:52 Page 2
FBXIP48 ;WOIFO/SS-PATCH INSTALL ROUTINE ;6/29/01
+1 ;;3.5;FEE BASIS;**48**;JAN 30, 1995
+2 QUIT
POST ;post-install entry point
+1 DO BMES^XPDUTL("Fee Basis LTC III, Post-Install Starting")
+2 DO SETLTC
+3 DO BMES^XPDUTL("Fee Basis LTC III, Post-Install Complet")
+4 QUIT
+5 ;
LTCTYP(FBIENCL,FBLTCTYP) ;
+1 NEW FBIENS,FBFDA,FBERR
+2 ; "D0,"
SET FBIENS=FBIENCL_","
+3 ;status (file#,IENS,field#)
SET FBFDA(161.82,FBIENS,5)=FBLTCTYP
+4 DO FILE^DIE("","FBFDA","FBERR")
+5 IF $DATA(FBERR)
Begin DoDot:1
+6 DO BMES^XPDUTL(+$GET(FBIENCL)_$GET(FBLTCTYP)_" "_$GET(FBERR("DIERR",1,"TEXT",1)))
End DoDot:1
+7 QUIT
+8 ;
SETLTC ;
+1 DO BMES^XPDUTL(" Populating field #5 LTC COPAY TYPE of file #161.82")
+2 NEW FBX,FBT,FBIEN
+3 FOR FBX=1:1
SET FBT=$PIECE($TEXT(POV+FBX),";",3)
if '$LENGTH(FBT)
QUIT
Begin DoDot:1
+4 SET FBIEN=+$ORDER(^FBAA(161.82,"C",+FBT,0))
+5 IF FBIEN=0
DO BMES^XPDUTL(" Error: there is no entry for "_+FBT_" code in 161.82")
QUIT
+6 DO LTCTYP(FBIEN,$PIECE(FBT,"^",2))
End DoDot:1
+7 QUIT
+8 ;
+9 ;
+10 ; Listed below are the POV codes related to LTC
+11 ; 40,42,43,70,71,74 are exempt for all patients (;;2)
POV ;
+1 ;;41^1^COMMUNITY NURSING HOME FOR NSC DISABILITY(IES)
+2 ;;44^1^CNH RESPITE CARE
+3 ;;72^1^RESPITE CARE IN HOMEMAKER/HOME HEALTH AID SERVICES
+4 ;;73^1^RESPITE CARE IN ADHC
+5 ;;76^1^ADHC
+6 ;;79^1^RESPITE CARE (OTHER)
+7 ;;40^2^COMMUNITY NURSING HOME FOR SC DISABILITY(IES)
+8 ;;43^2^CNH HOSPICE
+9 ;;
