FBXIP177 ;ALB/BJR-PATCH INSTALL ROUTINE ;4/12/17 3:26pm
;;3.5;FEE BASIS;**177**;JAN 30, 1995;Build 7
;;Per VA Directive 6402, this routine should not be modified.
Q
;
UPDPOV ; Update Selected Purpose of Visits (POV)
N FBCODE,FBDA,FBFDA,FBI,FBNAME,FBPROG,FBX,X,Y,FBCCODE
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"!($P($G(^FBAA(161.8,6,0)),U)'="CIVIL HOSPITAL") D Q
. D MES^XPDUTL(" ERROR: Fee Program IEN Mismatched.")
. D MES^XPDUTL(" Purpose of Visits could not be updated.")
. D MES^XPDUTL(" Please contact your IRM for assistance.")
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)
. N DA,DD,DIC,DINUM,DLAYGO,DO,X
. S FBCCODE=$O(^FBAA(161.82,"B",$E(FBNAME,1,63),"")) I FBCCODE,$P(^FBAA(161.82,FBCCODE,0),U,3)=FBCODE D MES^XPDUTL("POV WITH CODE "_FBCODE_" ALREADY EXISTS AND HAS NOT BEEN ADDED") Q
. S DIC="^FBAA(161.82,",DIC(0)="L",DLAYGO=161.82
. S X=FBNAME
. S DIC("DR")="2///^S X=FBPROG;3///^S X=FBCODE"
. 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) Q
. D MES^XPDUTL("POV WITH CODE "_FBCODE_" HAS BEEN ADDED")
D BMES^XPDUTL("Post Install Completed.")
Q
;
POV ;Austin code^name^fee program for Purpose of Visit (POV) code(s)^Additional Description
;;92^OUTPATIENT IVF / ART CARE - NON-VETERAN COLLATERAL SPOUSE^2
;;93^OUTPATIENT IVF / ART CARE - SC VETERAN^2
;;94^OUTPATIENT IVF / ART CARE - VETERAN COLLATERAL SPOUSE; FOR WHEN SPOUSE IS ALSO A VETERAN BUT NOT SC^2
;;95^INPATIENT IVF / ART CARE - NON-VETERAN COLLATERAL SPOUSE^6
;;96^INPATIENT IVF / ART CARE - SC VETERAN^6
;;97^INPATIENT IVF / ART CARE - VETERAN COLLATERAL SPOUSE; FOR WHEN SPOUSE IS ALSO A VETERAN BUT NOT SC^6
;;END
;
;FBXIP177
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBXIP177 1999 printed Oct 16, 2024@18:02:16 Page 2
FBXIP177 ;ALB/BJR-PATCH INSTALL ROUTINE ;4/12/17 3:26pm
+1 ;;3.5;FEE BASIS;**177**;JAN 30, 1995;Build 7
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
UPDPOV ; Update Selected Purpose of Visits (POV)
+1 NEW FBCODE,FBDA,FBFDA,FBI,FBNAME,FBPROG,FBX,X,Y,FBCCODE
+2 DO BMES^XPDUTL(" Updating selected POVs in the FEE BASIS PURPOSE OF VISIT (161.82) file...")
+3 ; verify IEN of OUTPATIENT program in FEE BASIS PROGRAM file
+4 IF $PIECE($GET(^FBAA(161.8,2,0)),U)'="OUTPATIENT"!($PIECE($GET(^FBAA(161.8,6,0)),U)'="CIVIL HOSPITAL")
Begin DoDot:1
+5 DO MES^XPDUTL(" ERROR: Fee Program IEN Mismatched.")
+6 DO MES^XPDUTL(" Purpose of Visits could not be updated.")
+7 DO MES^XPDUTL(" Please contact your IRM for assistance.")
End DoDot:1
QUIT
+8 FOR FBI=1:1
SET FBX=$PIECE($TEXT(POV+FBI),";;",2)
if FBX="END"
QUIT
Begin DoDot:1
+9 SET FBCODE=$PIECE(FBX,U)
+10 SET FBNAME=$PIECE(FBX,U,2)
+11 SET FBPROG=$PIECE(FBX,U,3)
+12 NEW DA,DD,DIC,DINUM,DLAYGO,DO,X
+13 SET FBCCODE=$ORDER(^FBAA(161.82,"B",$EXTRACT(FBNAME,1,63),""))
IF FBCCODE
IF $PIECE(^FBAA(161.82,FBCCODE,0),U,3)=FBCODE
DO MES^XPDUTL("POV WITH CODE "_FBCODE_" ALREADY EXISTS AND HAS NOT BEEN ADDED")
QUIT
+14 SET DIC="^FBAA(161.82,"
SET DIC(0)="L"
SET DLAYGO=161.82
+15 SET X=FBNAME
+16 SET DIC("DR")="2///^S X=FBPROG;3///^S X=FBCODE"
+17 IF +FBCODE
IF '$DATA(^FBAA(161.82,+FBCODE,0))
SET DINUM=+FBCODE
+18 DO FILE^DICN
+19 IF Y<0
DO MES^XPDUTL("ERROR ADDING POV WITH CODE "_FBCODE)
QUIT
+20 DO MES^XPDUTL("POV WITH CODE "_FBCODE_" HAS BEEN ADDED")
End DoDot:1
+21 DO BMES^XPDUTL("Post Install Completed.")
+22 QUIT
+23 ;
POV ;Austin code^name^fee program for Purpose of Visit (POV) code(s)^Additional Description
+1 ;;92^OUTPATIENT IVF / ART CARE - NON-VETERAN COLLATERAL SPOUSE^2
+2 ;;93^OUTPATIENT IVF / ART CARE - SC VETERAN^2
+3 ;;94^OUTPATIENT IVF / ART CARE - VETERAN COLLATERAL SPOUSE; FOR WHEN SPOUSE IS ALSO A VETERAN BUT NOT SC^2
+4 ;;95^INPATIENT IVF / ART CARE - NON-VETERAN COLLATERAL SPOUSE^6
+5 ;;96^INPATIENT IVF / ART CARE - SC VETERAN^6
+6 ;;97^INPATIENT IVF / ART CARE - VETERAN COLLATERAL SPOUSE; FOR WHEN SPOUSE IS ALSO A VETERAN BUT NOT SC^6
+7 ;;END
+8 ;
+9 ;FBXIP177
