- 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 ---[H[J[2J[HFBXIP91 1190 printed Jan 18, 2025@03:03:09 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