FBXIP48.m

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 ---FBXIP48   1287     printed  Apr 09, 2024@21:04:03                                                                                                                                                                                                     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       ;;