Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FBXIP32

FBXIP32.m

Go to the documentation of this file.
  1. FBXIP32 ;WOIFO/SAB-PATCH INSTALL ROUTINE ;7/19/2001
  1. ;;3.5;FEE BASIS;**32**;JAN 30, 1995
  1. Q
  1. ;
  1. PS ; post-install entry point
  1. ; create KIDS checkpoints with call backs
  1. N FBX,Y
  1. F FBX="UPDPOV","STATLTR","REQINFO" D
  1. . S Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP32")
  1. . I 'Y D BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")
  1. Q
  1. ;
  1. UPDPOV ; Update Selected Purpose of Visits (POV)
  1. N FBCODE,FBDA,FBFDA,FBI,FBNAME,FBPROG,FBX,X,Y
  1. D BMES^XPDUTL(" Updating selected POVs in the FEE BASIS PURPOSE OF VISIT (161.82) file...")
  1. ;
  1. ; verify IEN of OUTPATIENT program in FEE BASIS PROGRAM file
  1. ;I $P($G(^FBAA(161.8,2,0)),U)'="OUTPATIENT" D Q
  1. ;. D MES^XPDUTL(" ERROR: Fee Program with IEN 2 is not OUTPATIENT.")
  1. ;. D MES^XPDUTL(" Purpose of Visits could not be updated.")
  1. ;
  1. ; update POVs
  1. K FBFDA
  1. ; loop thru POVs
  1. F FBI=1:1 S FBX=$P($T(POV+FBI),";;",2) Q:FBX="END" D
  1. . S FBCODE=$P(FBX,U)
  1. . S FBNAME=$P(FBX,U,2)
  1. . S FBPROG=$P(FBX,U,3)
  1. . ;
  1. . ; locate POV in file
  1. . S FBDA=$$FIND1^DIC(161.82,"","X",FBCODE,"AC")
  1. . ;
  1. . ; if POV found then check and if necessary add to update array
  1. . I FBDA D
  1. . . I $$GET1^DIQ(161.82,FBDA_",",.01)'=FBNAME S FBFDA(161.82,FBDA_",",.01)=FBNAME
  1. . . I $$GET1^DIQ(161.82,FBDA_",",2,"I")'=FBPROG D
  1. . . . I FBPROG]"" S FBFDA(161.82,FBDA_",",2)=FBPROG
  1. . . . I FBPROG="" S FBFDA(161.82,FBDA_",",2)="@"
  1. . ;
  1. . ; if POV not found then add it
  1. . I 'FBDA D
  1. . . N DA,DD,DIC,DINUM,DLAYGO,DO,X
  1. . . S DIC="^FBAA(161.82,",DIC(0)="L",DLAYGO=161.82
  1. . . S X=FBNAME Q:X=""
  1. . . S DIC("DR")="3////^S X=FBCODE"
  1. . . I FBPROG]"" S DIC("DR")=DIC("DR")_";2////^S X=FBPROG"
  1. . . I +FBCODE,'$D(^FBAA(161.82,+FBCODE,0)) S DINUM=+FBCODE
  1. . . D FILE^DICN
  1. . . I Y<0 D MES^XPDUTL("ERROR ADDING POV WITH CODE "_FBCODE)
  1. ;
  1. ; actually update the found POVs
  1. I $D(FBFDA) D FILE^DIE("","FBFDA")
  1. ;
  1. D MES^XPDUTL(" Done.")
  1. Q
  1. ;
  1. POV ;austin code^name^fee program for Purpose of Visit (POV) code(s)
  1. ;;52^OUTPATIENT 38 U.S.C. 1725^
  1. ;;39^INPATIENT 38 U.S.C. 1725^6
  1. ;;END
  1. ;
  1. STATLTR ; Populate field .06 in file 162.92 for appropriate status
  1. N FBDA,FBFDA,FBORDER
  1. ; loop thru status orders that need to be populated
  1. F FBORDER=10,40,70,90 D
  1. . S FBDA=$$STATUS^FBUCUTL(FBORDER) ; get ien
  1. . Q:'FBDA
  1. . Q:$P($G(^FB(162.92,FBDA,0)),U,6)]"" ; field already populated
  1. . I FBORDER=10 S FBFDA(162.92,FBDA_",",.06)="1725 REQUEST INFO"
  1. . I FBORDER>10 S FBFDA(162.92,FBDA_",",.06)="1725 DISPOSITION"
  1. ; update entries
  1. I $D(FBFDA) D FILE^DIE("E","FBFDA") D MSG^DIALOG()
  1. Q
  1. ;
  1. REQINFO ; Add/Update data in file 162.93
  1. D SSFC^FBXIP32A ; signed statement from claimant
  1. Q
  1. ;FBXIP32