- 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 Apr 23, 2025@18:15:56 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
