FBXIP91.m

FBXIP91 ;WCIOFO/SAB-PATCH INSTALL ROUTINE ;4/28/2005

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

 Q

 ;

PS ; post-install entry point

 ; create KIDS checkpoints with call backs

 N FBX,Y

 F FBX="CVT" D

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

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

 Q

 ;

CVT ; Fix Invalid Data in Field #8.5 within the PRESCRIPTION muliple

 ; of file 162.1

 N FBC,FB85I,FBDA,FBDA1,FBFDA,FBTXT,FBX

 D BMES^XPDUTL("  Fixing data in SubFile 162.11 Field #8.5...")

 ;

 S FBC=0 ; init count of corrected values

 ; loop thru pharmacy invoices

 S FBDA=0 F  S FBDA=$O(^FBAA(162.1,FBDA)) Q:'FBDA  D

 . ; loop thru prescriptions

 . S FBDA1=0 F  S FBDA1=$O(^FBAA(162.1,FBDA,"RX",FBDA1)) Q:'FBDA1  D

 . . ; obtain internal value of field #8.5

 . . S FB85I=$P($G(^FBAA(162.1,FBDA,"RX",FBDA1,0)),U,21)

 . . S FBX=$S(FB85I="Yes":"Y",FB85I="No":"N",1:"")

 . . Q:FBX=""  ; not one of the values that should be converted

 . . S FBFDA(162.11,FBDA1_","_FBDA_",",8.5)=FBX

 . . D FILE^DIE("","FBFDA")

 . . S FBC=FBC+1

 ;

 S FBTXT="    "_FBC_" invalid value"_$S(FBC=1:" was",1:"s were")_" found and corrected."

 D MES^XPDUTL(FBTXT)

 Q

 ;

 ;FBXIP91

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBXIP91   1190     printed  Apr 09, 2024@21:07:03                                                                                                                                                                                                     Page 2

FBXIP91   ;WCIOFO/SAB-PATCH INSTALL ROUTINE ;4/28/2005

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

               Begin DoDot:1

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

 +5                IF 'Y

                       DO BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")

               End DoDot:1

 +6        QUIT 

 +7       ;

CVT       ; Fix Invalid Data in Field #8.5 within the PRESCRIPTION muliple

 +1       ; of file 162.1

 +2        NEW FBC,FB85I,FBDA,FBDA1,FBFDA,FBTXT,FBX

 +3        DO BMES^XPDUTL("  Fixing data in SubFile 162.11 Field #8.5...")

 +4       ;

 +5       ; init count of corrected values

           SET FBC=0

 +6       ; loop thru pharmacy invoices

 +7        SET FBDA=0

           FOR 

               SET FBDA=$ORDER(^FBAA(162.1,FBDA))

               if 'FBDA

                   QUIT 

               Begin DoDot:1

 +8       ; loop thru prescriptions

 +9                SET FBDA1=0

                   FOR 

                       SET FBDA1=$ORDER(^FBAA(162.1,FBDA,"RX",FBDA1))

                       if 'FBDA1

                           QUIT 

                       Begin DoDot:2

 +10      ; obtain internal value of field #8.5

 +11                       SET FB85I=$PIECE($GET(^FBAA(162.1,FBDA,"RX",FBDA1,0)),U,21)

 +12                       SET FBX=$SELECT(FB85I="Yes":"Y",FB85I="No":"N",1:"")

 +13      ; not one of the values that should be converted

                           if FBX=""

                               QUIT 

 +14                       SET FBFDA(162.11,FBDA1_","_FBDA_",",8.5)=FBX

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

 +16                       SET FBC=FBC+1

                       End DoDot:2

               End DoDot:1

 +17      ;

 +18       SET FBTXT="    "_FBC_" invalid value"_$SELECT(FBC=1:" was",1:"s were")_" found and corrected."

 +19       DO MES^XPDUTL(FBTXT)

 +20       QUIT 

 +21      ;

 +22      ;FBXIP91