FBXIP32 ;WOIFO/SAB-PATCH INSTALL ROUTINE ;7/19/2001
;;3.5;FEE BASIS;**32**;JAN 30, 1995
Q
;
PS ; post-install entry point
; create KIDS checkpoints with call backs
N FBX,Y
F FBX="UPDPOV","STATLTR","REQINFO" D
. S Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP32")
. I 'Y D BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")
Q
;
UPDPOV ; Update Selected Purpose of Visits (POV)
N FBCODE,FBDA,FBFDA,FBI,FBNAME,FBPROG,FBX,X,Y
D BMES^XPDUTL(" Updating selected POVs in the FEE BASIS PURPOSE OF VISIT (161.82) file...")
;
; verify IEN of OUTPATIENT program in FEE BASIS PROGRAM file
;I $P($G(^FBAA(161.8,2,0)),U)'="OUTPATIENT" D Q
;. D MES^XPDUTL(" ERROR: Fee Program with IEN 2 is not OUTPATIENT.")
;. D MES^XPDUTL(" Purpose of Visits could not be updated.")
;
; update POVs
K FBFDA
; loop thru POVs
F FBI=1:1 S FBX=$P($T(POV+FBI),";;",2) Q:FBX="END" D
. S FBCODE=$P(FBX,U)
. S FBNAME=$P(FBX,U,2)
. S FBPROG=$P(FBX,U,3)
. ;
. ; locate POV in file
. S FBDA=$$FIND1^DIC(161.82,"","X",FBCODE,"AC")
. ;
. ; if POV found then check and if necessary add to update array
. I FBDA D
. . I $$GET1^DIQ(161.82,FBDA_",",.01)'=FBNAME S FBFDA(161.82,FBDA_",",.01)=FBNAME
. . I $$GET1^DIQ(161.82,FBDA_",",2,"I")'=FBPROG D
. . . I FBPROG]"" S FBFDA(161.82,FBDA_",",2)=FBPROG
. . . I FBPROG="" S FBFDA(161.82,FBDA_",",2)="@"
. ;
. ; if POV not found then add it
. I 'FBDA D
. . N DA,DD,DIC,DINUM,DLAYGO,DO,X
. . S DIC="^FBAA(161.82,",DIC(0)="L",DLAYGO=161.82
. . S X=FBNAME Q:X=""
. . S DIC("DR")="3////^S X=FBCODE"
. . I FBPROG]"" S DIC("DR")=DIC("DR")_";2////^S X=FBPROG"
. . I +FBCODE,'$D(^FBAA(161.82,+FBCODE,0)) S DINUM=+FBCODE
. . D FILE^DICN
. . I Y<0 D MES^XPDUTL("ERROR ADDING POV WITH CODE "_FBCODE)
;
; actually update the found POVs
I $D(FBFDA) D FILE^DIE("","FBFDA")
;
D MES^XPDUTL(" Done.")
Q
;
POV ;austin code^name^fee program for Purpose of Visit (POV) code(s)
;;52^OUTPATIENT 38 U.S.C. 1725^
;;39^INPATIENT 38 U.S.C. 1725^6
;;END
;
STATLTR ; Populate field .06 in file 162.92 for appropriate status
N FBDA,FBFDA,FBORDER
; loop thru status orders that need to be populated
F FBORDER=10,40,70,90 D
. S FBDA=$$STATUS^FBUCUTL(FBORDER) ; get ien
. Q:'FBDA
. Q:$P($G(^FB(162.92,FBDA,0)),U,6)]"" ; field already populated
. I FBORDER=10 S FBFDA(162.92,FBDA_",",.06)="1725 REQUEST INFO"
. I FBORDER>10 S FBFDA(162.92,FBDA_",",.06)="1725 DISPOSITION"
; update entries
I $D(FBFDA) D FILE^DIE("E","FBFDA") D MSG^DIALOG()
Q
;
REQINFO ; Add/Update data in file 162.93
D SSFC^FBXIP32A ; signed statement from claimant
Q
;FBXIP32
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBXIP32 2660 printed Dec 13, 2024@02:01:39 Page 2
FBXIP32 ;WOIFO/SAB-PATCH INSTALL ROUTINE ;7/19/2001
+1 ;;3.5;FEE BASIS;**32**;JAN 30, 1995
+2 QUIT
+3 ;
PS ; post-install entry point
+1 ; create KIDS checkpoints with call backs
+2 NEW FBX,Y
+3 FOR FBX="UPDPOV","STATLTR","REQINFO"
Begin DoDot:1
+4 SET Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP32")
+5 IF 'Y
DO BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")
End DoDot:1
+6 QUIT
+7 ;
UPDPOV ; Update Selected Purpose of Visits (POV)
+1 NEW FBCODE,FBDA,FBFDA,FBI,FBNAME,FBPROG,FBX,X,Y
+2 DO BMES^XPDUTL(" Updating selected POVs in the FEE BASIS PURPOSE OF VISIT (161.82) file...")
+3 ;
+4 ; verify IEN of OUTPATIENT program in FEE BASIS PROGRAM file
+5 ;I $P($G(^FBAA(161.8,2,0)),U)'="OUTPATIENT" D Q
+6 ;. D MES^XPDUTL(" ERROR: Fee Program with IEN 2 is not OUTPATIENT.")
+7 ;. D MES^XPDUTL(" Purpose of Visits could not be updated.")
+8 ;
+9 ; update POVs
+10 KILL FBFDA
+11 ; loop thru POVs
+12 FOR FBI=1:1
SET FBX=$PIECE($TEXT(POV+FBI),";;",2)
if FBX="END"
QUIT
Begin DoDot:1
+13 SET FBCODE=$PIECE(FBX,U)
+14 SET FBNAME=$PIECE(FBX,U,2)
+15 SET FBPROG=$PIECE(FBX,U,3)
+16 ;
+17 ; locate POV in file
+18 SET FBDA=$$FIND1^DIC(161.82,"","X",FBCODE,"AC")
+19 ;
+20 ; if POV found then check and if necessary add to update array
+21 IF FBDA
Begin DoDot:2
+22 IF $$GET1^DIQ(161.82,FBDA_",",.01)'=FBNAME
SET FBFDA(161.82,FBDA_",",.01)=FBNAME
+23 IF $$GET1^DIQ(161.82,FBDA_",",2,"I")'=FBPROG
Begin DoDot:3
+24 IF FBPROG]""
SET FBFDA(161.82,FBDA_",",2)=FBPROG
+25 IF FBPROG=""
SET FBFDA(161.82,FBDA_",",2)="@"
End DoDot:3
End DoDot:2
+26 ;
+27 ; if POV not found then add it
+28 IF 'FBDA
Begin DoDot:2
+29 NEW DA,DD,DIC,DINUM,DLAYGO,DO,X
+30 SET DIC="^FBAA(161.82,"
SET DIC(0)="L"
SET DLAYGO=161.82
+31 SET X=FBNAME
if X=""
QUIT
+32 SET DIC("DR")="3////^S X=FBCODE"
+33 IF FBPROG]""
SET DIC("DR")=DIC("DR")_";2////^S X=FBPROG"
+34 IF +FBCODE
IF '$DATA(^FBAA(161.82,+FBCODE,0))
SET DINUM=+FBCODE
+35 DO FILE^DICN
+36 IF Y<0
DO MES^XPDUTL("ERROR ADDING POV WITH CODE "_FBCODE)
End DoDot:2
End DoDot:1
+37 ;
+38 ; actually update the found POVs
+39 IF $DATA(FBFDA)
DO FILE^DIE("","FBFDA")
+40 ;
+41 DO MES^XPDUTL(" Done.")
+42 QUIT
+43 ;
POV ;austin code^name^fee program for Purpose of Visit (POV) code(s)
+1 ;;52^OUTPATIENT 38 U.S.C. 1725^
+2 ;;39^INPATIENT 38 U.S.C. 1725^6
+3 ;;END
+4 ;
STATLTR ; Populate field .06 in file 162.92 for appropriate status
+1 NEW FBDA,FBFDA,FBORDER
+2 ; loop thru status orders that need to be populated
+3 FOR FBORDER=10,40,70,90
Begin DoDot:1
+4 ; get ien
SET FBDA=$$STATUS^FBUCUTL(FBORDER)
+5 if 'FBDA
QUIT
+6 ; field already populated
if $PIECE($GET(^FB(162.92,FBDA,0)),U,6)]""
QUIT
+7 IF FBORDER=10
SET FBFDA(162.92,FBDA_",",.06)="1725 REQUEST INFO"
+8 IF FBORDER>10
SET FBFDA(162.92,FBDA_",",.06)="1725 DISPOSITION"
End DoDot:1
+9 ; update entries
+10 IF $DATA(FBFDA)
DO FILE^DIE("E","FBFDA")
DO MSG^DIALOG()
+11 QUIT
+12 ;
REQINFO ; Add/Update data in file 162.93
+1 ; signed statement from claimant
DO SSFC^FBXIP32A
+2 QUIT
+3 ;FBXIP32
