FBXIP177.m

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 ---FBXIP177   1999     printed  Apr 09, 2024@21:07:07                                                                                                                                                                                                    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