source: FOIAVistA/trunk/r/FEE_BASIS-FB/FBXIP34.m@ 761

Last change on this file since 761 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1FBXIP34 ;WOIFO/MJE-PATCH INSTALL ROUTINE ;6/7/01
2 ;;3.5;FEE BASIS;**34**;JAN 30, 1995
3 Q
4 ;
5PS ; post-install entry point
6 ; create KIDS checkpoints with call backs
7 N FBX,Y
8 F FBX="UPDPOV" D
9 . S Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP34")
10 . I 'Y D BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")
11 Q
12 ;
13UPDPOV ; Update Selected Purpose of Visits (POV)
14 N FBCODE,FBDA,FBFDA,FBI,FBNAME,FBPROG,FBX,X,Y
15 D BMES^XPDUTL(" Updating selected POVs in the FEE BASIS PURPOSE OF VISIT (161.82) file...")
16 ;
17 ; verify IEN of OUTPATIENT program in FEE BASIS PROGRAM file
18 I $P($G(^FBAA(161.8,2,0)),U)'="OUTPATIENT" D Q
19 . D MES^XPDUTL(" ERROR: Fee Program with IEN 2 is not OUTPATIENT.")
20 . D MES^XPDUTL(" Purpose of Visits could not be updated.")
21 ;
22 ; verify IEN of CONTRACT NURSING HOME in FEE BASIS PROGRAM file
23 I $P($G(^FBAA(161.8,7,0)),U)'="CONTRACT NURSING HOME" D Q
24 . D MES^XPDUTL(" ERROR: Fee Program with IEN 7 is not CONTRACT NURSING HOME.")
25 . D MES^XPDUTL(" Purpose of Visits could not be updated.")
26 ;
27 ; update POVs
28 K FBFDA
29 ; loop thru POVs
30 F FBI=1:1 S FBX=$P($T(POV+FBI),";;",2) Q:FBX="END" D
31 . S FBCODE=$P(FBX,U)
32 . S FBNAME=$P(FBX,U,2)
33 . S FBPROG=$P(FBX,U,3)
34 . ;
35 . ; locate POV in file
36 . S FBDA=$$FIND1^DIC(161.82,"","X",FBCODE,"AC")
37 . ;
38 . ; if POV found then check and if necessary add to update array
39 . I FBDA D
40 . . I $$GET1^DIQ(161.82,FBDA_",",.01)'=FBNAME S FBFDA(161.82,FBDA_",",.01)=FBNAME
41 . . I $$GET1^DIQ(161.82,FBDA_",",2,"I")'=FBPROG S FBFDA(161.82,FBDA_",",2)=FBPROG
42 . ;
43 . ; if POV not found then add it
44 . I 'FBDA D
45 . . N DA,DD,DIC,DINUM,DLAYGO,DO,X
46 . . S DIC="^FBAA(161.82,",DIC(0)="L",DLAYGO=161.82
47 . . S X=FBNAME Q:X=""
48 . . S DIC("DR")="2////^S X=FBPROG;3////^S X=FBCODE"
49 . . I +FBCODE,'$D(^FBAA(161.82,+FBCODE,0)) S DINUM=+FBCODE
50 . . D FILE^DICN
51 . . I Y<0 D MES^XPDUTL("ERROR ADDING POV WITH CODE "_FBCODE)
52 ;
53 ; actually update the found POVs
54 I $D(FBFDA) D FILE^DIE("","FBFDA")
55 ;
56 D MES^XPDUTL(" Done.")
57 Q
58 ;
59POV ;austin code^name^fee program for Purpose of Visit (POV) code(s)
60 ;;43^CNH HOSPICE & PALLIATIVE CARE^7
61 ;;44^CNH RESPITE CARE^7
62 ;;71^HOMEMAKER/HOME HEALTH AID SERVICES^2
63 ;;74^HOME HEALTH SERVICES (NON-NURSING PROFESSIONAL)^2
64 ;;76^ADHC^2
65 ;;77^HOSPICE & PALLIATIVE CARE (OPT) - CONTRACT/SHARING AGREEMENT^2
66 ;;78^HOSPICE & PALLIATIVE CARE (OPT) - FEE BASIS AUTHORITY (CFR 17.50b)^2
67 ;;END
68 ;
69 ;FBXIP34
Note: See TracBrowser for help on using the repository browser.