Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FBXIP19

FBXIP19.m

Go to the documentation of this file. 
  1. FBXIP19 ;WCIOFO/SAB-PATCH INSTALL ROUTINE ;10/25/2000
  1.  ;;3.5;FEE BASIS;**19**;JAN 30, 1995
  1.  ; This routine invokes IA #3228
  1.  Q
  1.  ;
  1. PR ; pre-install entry point
  1.  ; create KIDS checkpoints with call backs
  1.  N FBX,Y
  1.  F FBX="DXREF" D
  1.  . S Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP19")
  1.  . I 'Y D BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")
  1.  Q
  1.  ;
  1. PS ; post-install entry point
  1.  ;
  1.  ; only perform during 1st install
  1.  I $$PATCH^XPDUTL("FB*3.5*19") D BMES^XPDUTL("  Skipping post install since patch was previously installed.") Q
  1.  ;
  1.  ; create KIDS checkpoints with call backs
  1.  N FBX,Y
  1.  F FBX="MERGED" D
  1.  . S Y=$$NEWCP^XPDUTL(FBX,FBX_"^FBXIP19")
  1.  . I 'Y D BMES^XPDUTL("ERROR Creating "_FBX_" Checkpoint.")
  1.  Q
  1.  ;
  1. DXREF ; Delete cross-references (Pre Install)
  1.  ;
  1.  ; Delete trigger x-ref because new logic has fewer nodes in DD
  1.  D DELIX^DDMOD(162.11,.01,2) ; trigger x-ref
  1.  ;
  1.  ; This section deletes existing traditional style cross reference logic
  1.  ; whose functionality is being replaced by new style cross references
  1.  ; included in this patch.
  1.  D DELIX^DDMOD(162.11,7,1) ; AG x-ref
  1.  D DELIX^DDMOD(162.11,13,2) ; AJ x-ref
  1.  D DELIX^DDMOD(162.11,13,3) ; AK x-ref
  1.  D DELIX^DDMOD(162.11,15,1) ; AA x-ref
  1.  D DELIX^DDMOD(162.2,14,1) ; AI x-ref
  1.  D DELIX^DDMOD(162.3,3,1) ; AD x-ref
  1.  D DELIX^DDMOD(162.5,1,1) ; AI1 x-ref
  1.  D DELIX^DDMOD(162.5,10,1) ; AI x-ref
  1.  D DELIX^DDMOD(162.5,5,1) ; AA x-ref
  1.  D DELIX^DDMOD(162.5,20,2) ; AE x-ref
  1.  Q
  1.  ;
  1. MERGED ; Check previously merged patients and fix FEE as needed (post install)
  1.  N FBAUTCHG,FBDA,FBFR,FBTO,FBX
  1.  K ^TMP($J)
  1.  ; loop through MERGE IMAGES file (IA #3228)
  1.  S FBDA=0 F  S FBDA=$O(^XDRM(FBDA)) Q:'FBDA  D
  1.  . S FBX=$G(^XDRM(FBDA,0))
  1.  . Q:$P($P(FBX,U),";",2)'="DPT("  ; from is not PATIENT file
  1.  . Q:$P($P(FBX,U,2),";",2)'="DPT("  ; to is not PATIENT file
  1.  . S FBFR=$P($P(FBX,U),";") ; From IEN of patient
  1.  . S FBTO=$P($P(FBX,U,2),";") ; To IEN of patient
  1.  . ;
  1.  . D LOADBI^FBXIP19A(1) ; load FEE before images for FBFR into ^TMP
  1.  . D LOADBI^FBXIP19A(2) ; load FEE before images for FBTO into ^TMP
  1.  . ;
  1.  . ; process FEE BASIS PATIENT file authorization multiple (161.01)
  1.  . D FB16101^FBXIP19A
  1.  . ;I $D(FBAUTCHG) W ! ZW FBAUTCHG
  1.  . ;
  1.  . ; process FEE BASIS PAYMENT file service provided multiple (162.03)
  1.  . D FB16203^FBXIP19A
  1.  . ;
  1.  . ; process FEE BASIS PAYMENT file travel payment multiple (162.04)
  1.  . D FB16204^FBXIP19A
  1.  . ;
  1.  . ; process changed pointers
  1.  . D PCHG
  1.  . ;
  1.  ; report any problems via mail message
  1.  I $D(^TMP($J,"PROB")) D
  1.  . N DIFROM,FBFILE,FBFR,FBIENS,FBL,FBTO,FBTXT,XMDUZ,XMSUB,XMTEXT,XMY
  1.  . ; build message text
  1.  . S ^TMP($J,"MSG",1)="The patch FB*3.5*19 post install was not able to automatically"
  1.  . S ^TMP($J,"MSG",2)="process some of the previously merged fee data."
  1.  . S ^TMP($J,"MSG",3)="This mail message has been sent to a developer for review."
  1.  . S FBL=3 ; last line used for message text
  1.  . ;loop thru problems and load appropriate text into message
  1.  . S FBFR=0 F  S FBFR=$O(^TMP($J,"PROB",FBFR)) Q:'FBFR  D
  1.  . . S FBTO=$P($G(^TMP($J,"PROB",FBFR)),U)
  1.  . . S FBL=FBL+1 S ^TMP($J,"MSG",FBL)=" "
  1.  . . S FBL=FBL+1 S ^TMP($J,"MSG",FBL)="ISSUES FOR PATIENT MERGED FROM "_FBFR_" INTO "_FBTO
  1.  . . S FBFILE=""
  1.  . . F  S FBFILE=$O(^TMP($J,"PROB",FBFR,FBFILE)) Q:FBFILE=""  D
  1.  . . . S FBIENS=""
  1.  . . . F  S FBIENS=$O(^TMP($J,"PROB",FBFR,FBFILE,FBIENS)) Q:FBIENS=""  D
  1.  . . . . S FBTXT=$G(^TMP($J,"PROB",FBFR,FBFILE,FBIENS))
  1.  . . . . S FBL=FBL+1,^TMP($J,"MSG",FBL)="  FILE: "_FBFILE_"  IENS: "_FBIENS
  1.  . . . . S FBL=FBL+1,^TMP($J,"MSG",FBL)="    "_FBTXT
  1.  . S XMSUB="POST INSTALL FB*3.5*19"
  1.  . S XMDUZ=.5
  1.  . S XMTEXT="^TMP($J,""MSG"","
  1.  . S XMY("BAUMANN,SCOTT@DOMAIN.EXT")="",XMY(DUZ)=""
  1.  . D ^XMD
  1.  ;
  1.  ; cleanup
  1.  K ^TMP($J)
  1.  Q
  1.  ;
  1. PCHG ; Process Pointers Changed multiple in MERGE IMAGES file
  1.  ; before this patch, nine x-refs depended on the patient but were
  1.  ; not updated if the patient pointer was changed.
  1.  ; check/update those x-refs for patients merged prior to this patch
  1.  ; also update 'free-text' authorization pointers when necessary
  1.  ; input
  1.  ;   FBDA - entry in MERGE IMAGES file
  1.  ;   FBAUTCHG(old ien,new ien) - array of changed authorization iens
  1.  ; output
  1.  ;   update cross-reference values in various FEE files
  1.  ;   update 'free-text' authorization pointers in various FEE files
  1.  ;
  1.  N FBDA1,FBFILE,FBFLD,FBIENS,FBOVAL,FBPC
  1.  ;
  1.  ; loop thru "B" x-ref of POINTERS CHANGED multiple in MERGE IMAGES
  1.  S FBPC="161 "
  1.  F  S FBPC=$O(^XDRM(FBDA,3,"B",FBPC)) Q:FBPC=""!(FBPC]"164 ")  D
  1.  . S FBDA1=0 F  S FBDA1=$O(^XDRM(FBDA,3,"B",FBPC,FBDA1)) Q:'FBDA1  D
  1.  . . S FBFILE=$P($P(FBPC,U),";")
  1.  . . S FBIENS=$P($P(FBPC,U),";",2)
  1.  . . S FBFLD=$P($P(FBPC,U),";",3)
  1.  . . S FBOVAL=$P($G(^XDRM(FBDA,3,FBDA1,1)),U)
  1.  . . Q:FBOVAL=""
  1.  . . ;W !,"POINTER CHANGED for FILE: "_FBFILE_"  FIELD: "_FBFLD_"  OLD VAL "_FBOVAL_"  IENS: "_FBIENS
  1.  . . ;Q  ; *** temp quit for testing
  1.  . . I FBFILE=161.26,FBFLD=.01 D F16126
  1.  . . I FBFILE=162.11,FBFLD=4 D F16211
  1.  . . I FBFILE=162.2,FBFLD=3 D F1622
  1.  . . I FBFILE=162.3,FBFLD=1 D F1623
  1.  . . I FBFILE=162.5,FBFLD=3 D F1625
  1.  . . I FBFILE=162.7,FBFLD=2 D F1627
  1.  Q
  1.  ;
  1. F16126 ; file 161.26 field .01 check/fix 'free-text' pointer
  1.  N DA,DIE,DR,FBFTPC,FBFTPN,FBY
  1.  D DA^DILF(FBIENS,.DA)
  1.  Q:'DA
  1.  S FBY=$G(^FBAA(161.26,DA,0))
  1.  ;
  1.  ; update 'free-text' authorization pointer if it changed
  1.  S FBFTPC=$P(FBY,U,3) ; current
  1.  S FBFTPN=$S(FBFTPC:$O(FBAUTCHG(FBFTPC,0)),1:"") ; new (if different)
  1.  I FBFTPN,FBFTPN'=FBFTPC D
  1.  . S DIE="^FBAA(161.26,"
  1.  . S DR="2////^S X=FBFTPN"
  1.  . D ^DIE
  1.  Q
  1.  ;
  1. F16211 ; file 162.11 field 4 check/fix x-refs & 'free-text' pointer
  1.  N DA,DIE,DIK,DR,FBFTPC,FBFTPN,FBRXY,FBY
  1.  D DA^DILF(FBIENS,.DA)
  1.  Q:'DA(1)
  1.  Q:'DA
  1.  S FBY=$G(^FBAA(162.1,DA(1),0))
  1.  S FBRXY=$G(^FBAA(162.1,DA(1),"RX",DA,0))
  1.  ;
  1.  ; delete "AG" x-ref for old value
  1.  I $P(FBY,U,4)]"",$P(FBY,U,8)]"",$P(FBRXY,U,8)]"" K ^FBAA(162.1,"AG",$P(FBY,U,4),$P(FBY,U,8),FBOVAL,$P(FBRXY,U,8),DA(1),DA)
  1.  ; delete "AJ" x-ref for old value
  1.  I $P(FBRXY,U,17)]"" K ^FBAA(162.1,"AJ",$P(FBRXY,U,17),FBOVAL,DA(1),DA)
  1.  ; delete "AK" x-ref for old value
  1.  I $P(FBY,U,4)]"",$P(FBRXY,U,3)]"" K ^FBAA(162.1,"AK",$P(FBY,U,4),9999999-$P(FBRXY,U,3),FBOVAL,DA(1),DA)
  1.  ; delete "AA" x-ref for old value
  1.  I $P(FBRXY,U,19)]"" K ^FBAA(162.1,"AA",$P(FBRXY,U,19),FBOVAL,DA(1),DA)
  1.  ; re-index "AG","AJ","AK","AA" x-refs for entry
  1.  S DIK="^FBAA(162.1,"_DA(1)_",""RX"","
  1.  S DIK(1)="4^AA^AG^AJ^AK"
  1.  D EN1^DIK
  1.  ;
  1.  ; update 'free-text' authorization pointer if it changed
  1.  S FBFTPC=$P($G(^FBAA(162.1,DA(1),"RX",DA,2)),U,7) ; current
  1.  S FBFTPN=$S(FBFTPC:$O(FBAUTCHG(FBFTPC,0)),1:"") ; new (if different)
  1.  I FBFTPN,FBFTPN'=FBFTPC D
  1.  . S DIE="^FBAA(162.1,"_DA(1)_",""RX"","
  1.  . S DR="27////^S X=FBFTPN"
  1.  . D ^DIE
  1.  Q
  1.  ;
  1. F1622 ; file 162.2 field 3 check/fix x-ref
  1.  N DA,DIK,FBY
  1.  D DA^DILF(FBIENS,.DA)
  1.  Q:'DA
  1.  S FBY=$G(^FBAA(162.2,DA,0))
  1.  ;
  1.  ; delete "AI" x-ref for old value
  1.  I $P(FBY,U,2)]"",$P(FBY,U,13)]"",$P(FBY,U,16)]"" K ^FBAA(162.2,"AI",$P(FBY,U,2),$P(FBY,U,13),FBOVAL,$P(FBY,U,16),DA)
  1.  ; re-index "AI" x-ref for entry
  1.  S DIK="^FBAA(162.2,"
  1.  S DIK(1)="3^AI"
  1.  D EN1^DIK
  1.  Q
  1.  ;
  1. F1623 ; file 162.3 field 1 check/fix x-ref and 'free-text' pointer
  1.  N DA,DIE,DIK,DR,FBFTPC,FBFTPN,FBY
  1.  D DA^DILF(FBIENS,.DA)
  1.  Q:'DA
  1.  S FBY=$G(^FBAACNH(DA,0))
  1.  ;
  1.  ; delete "AD" x-ref for old value
  1.  I $P(FBY,U,4)]"" K ^FBAACNH("AD",FBOVAL,DA)
  1.  ; re-index "AD" x-ref for entry
  1.  S DIK="^FBAACNH("
  1.  S DIK(1)="1^AD"
  1.  D EN1^DIK
  1.  ;
  1.  ; update 'free-text' authorization pointer if it changed
  1.  S FBFTPC=$P(FBY,U,10) ; current
  1.  S FBFTPN=$S(FBFTPC:$O(FBAUTCHG(FBFTPC,0)),1:"") ; new (if different)
  1.  I FBFTPN,FBFTPN'=FBFTPC D
  1.  . S DIE="^FBAACNH("
  1.  . S DR="9////^S X=FBFTPN"
  1.  . D ^DIE
  1.  Q
  1.  ;
  1. F1625 ; file 162.5 field 3 check/fix x-refs
  1.  N DA,DIK,FBY
  1.  D DA^DILF(FBIENS,.DA)
  1.  Q:'DA
  1.  S FBY=$G(^FBAAI(DA,0))
  1.  ;
  1.  ; delete "AI" x-ref for old value
  1.  I $P(FBY,U,3)]"",$P(FBY,U,2)]"",$P(FBY,U,11)]"" K ^FBAAI("AI",$P(FBY,U,3),$P(FBY,U,2),FBOVAL,$P(FBY,U,11),DA)
  1.  ; delete "AA" x-ref for old value
  1.  I $P(FBY,U,3)]"",$P(FBY,U,6)]"" K ^FBAAI("AA",$P(FBY,U,3),FBOVAL,$E($P($P(FBY,U,6),"."),1,5),DA)
  1.  ; delete "AE" x-ref for old value
  1.  I $P(FBY,U,17)]"" K ^FBAAI("AE",$P(FBY,U,17),FBOVAL,DA)
  1.  ; re-index "AI","AA","AE" x-refs for entry
  1.  S DIK="^FBAAI("
  1.  S DIK(1)="3^AI^AA^AE"
  1.  D EN1^DIK K DIK
  1.  Q
  1.  ;
  1. F1627 ; file 162.7 field 2 check/fix 'free-text' pointer
  1.  N DA,DIE,DR,FBFTPC,FBFTPN,FBY
  1.  D DA^DILF(FBIENS,.DA)
  1.  Q:'DA
  1.  S FBY=$G(^FB583(DA,0))
  1.  ;
  1.  ; update 'free-text' authorization pointer if it changed
  1.  S FBFTPC=$P(FBY,U,27) ; current
  1.  S FBFTPN=$S(FBFTPC:$O(FBAUTCHG(FBFTPC,0)),1:"") ; new (if different)
  1.  I FBFTPN,FBFTPN'=FBFTPC D
  1.  . S DIE="^FB583("
  1.  . S DR="30////^S X=FBFTPN"
  1.  . D ^DIE
  1.  Q
  1.  ;
  1.  ;FBXIP19