Routine: FBXIP37

FBXIP37 ;WOIFO/MJE-PATCH INSTALL ROUTINE ;9/21/01

 ;;3.5;FEE BASIS;**37**;JAN 30, 1995

PS ; post-install entry point

 ; create KIDS checkpoints with call backs

 N FBX,Y

 F FBX="UPDPOV" D

 .S Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP37")

 .I 'Y D BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")

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 S FBFDA(161.82,FBDA_",",2)=FBPROG

.;

 .; 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")="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)

 ; actually update the found POVs

 I $D(FBFDA) D FILE^DIE("","FBFDA")

 D MES^XPDUTL("    Done.")

POV ;austin code^name^fee program for Purpose of Visit (POV) code(s)

 ;;72^RESPITE CARE IN HOMEMAKER/HOME HEALTH AID SERVICES^2

 ;;73^RESPITE CARE IN ADHC^2

 ;;79^RESPITE CARE (OTHER)^2

 ;;END

 ;FBXIP37

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBXIP37   1928     printed  Mar 13, 2025@21:06:40                                                                                                                                                                                                     Page 2

FBXIP37   ;WOIFO/MJE-PATCH INSTALL ROUTINE ;9/21/01

 +1       ;;3.5;FEE BASIS;**37**;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"

               Begin DoDot:1

 +4                SET Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP37")

 +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        IF $PIECE($GET(^FBAA(161.8,2,0)),U)'="OUTPATIENT"

               Begin DoDot:1

 +6                DO MES^XPDUTL("    ERROR: Fee Program with IEN 2 is not OUTPATIENT.")

 +7                DO MES^XPDUTL("    Purpose of Visits could not be updated.")

               End DoDot:1

               QUIT

 +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

                               SET FBFDA(161.82,FBDA_",",2)=FBPROG

                       End DoDot:2

 +24      ;

 +25      ; if POV not found then add it

 +26               IF 'FBDA

                       Begin DoDot:2

 +27                       NEW DA,DD,DIC,DINUM,DLAYGO,DO,X

 +28                       SET DIC="^FBAA(161.82,"

                           SET DIC(0)="L"

                           SET DLAYGO=161.82

 +29                       SET X=FBNAME

                           if X=""

                               QUIT

 +30                       SET DIC("DR")="2////^S X=FBPROG;3////^S X=FBCODE"

 +31                       IF +FBCODE

                               IF '$DATA(^FBAA(161.82,+FBCODE,0))

                                   SET DINUM=+FBCODE

 +32                       DO FILE^DICN

 +33                       IF Y<0

                               DO MES^XPDUTL("ERROR ADDING POV WITH CODE "_FBCODE)

                       End DoDot:2

               End DoDot:1

 +34      ;

 +35      ; actually update the found POVs

 +36       IF $DATA(FBFDA)

               DO FILE^DIE("","FBFDA")

 +37       DO MES^XPDUTL("    Done.")

 +38       QUIT

 +39      ;

POV       ;austin code^name^fee program for Purpose of Visit (POV) code(s)

 +1       ;;72^RESPITE CARE IN HOMEMAKER/HOME HEALTH AID SERVICES^2

 +2       ;;73^RESPITE CARE IN ADHC^2

 +3       ;;79^RESPITE CARE (OTHER)^2

 +4       ;;END

 +5       ;

 +6       ;FBXIP37

FBXIP37.m