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

IBYOPOST.m

Go to the documentation of this file. 
  1. IBYOPOST ;ALB/TMP - IB*2*51 POST-INSTALL ;22-JAN-96
  1.  ;;2.0;INTEGRATED BILLING;**51**;21-MAR-94
  1.  ;
  1. POST ;Set up check points for post-init
  1.  S %=$$NEWCP^XPDUTL("UPDXREF","XREF^IBYOPOST")
  1.  S %=$$NEWCP^XPDUTL("FIXTOS","FIXTOS^IBYOPOST")
  1.  S %=$$NEWCP^XPDUTL("MOVEMOD","MOVEMOD^IBYOPOST")
  1.  S %=$$NEWCP^XPDUTL("ADDFORMS","ADDFORMS^IBYOPOS1")
  1.  K ^XTMP("IB20_51")
  1.  K PROD
  1.  Q
  1.  ;
  1. FIXTOS ; Fix 2 entries in type of service file
  1.  D BMES^XPDUTL("Fixing entries in Type of Service file")
  1.  N DA,DR,DIE,X,Y
  1.  S DA=$O(^IBE(353.2,"B","B",0)) ;Change 'B' type of service to 'F'
  1.  I DA S DR=".01///F",DIE="^IBE(353.2," D ^DIE
  1.  S DA=$O(^IBE(353.2,"B","L",0)) ;Change 'L' desc from rental to renal
  1.  I DA S DR=".02////RENAL SUPPLIES IN THE HOME;.03////^S X=""RENAL SUPPLIES/HOME""",DIE="^IBE(353.2," D ^DIE
  1.  D COMPLETE
  1.  Q
  1.  ;
  1. XREF ; Update files by running the new cross references
  1.  ;
  1.  D BMES^XPDUTL("Running new 'D' cross reference on FORM,PAGE,LINE,COLUMN in file 364.6.")
  1.  S DIK="^IBA(364.6,",DIK(1)=".04^D" D ENALL^DIK
  1.  ;
  1.  ; Run trigger for field .01 that sets the ASSOCIATED FORM
  1.  ; DEFINITION field for SCREEN forms
  1.  D BMES^XPDUTL("Running trigger of ASSOCIATED FORM DEFINITION in file 364.6.")
  1.  S DIK="^IBA(364.6,",DIK(1)=".01^4" D ENALL^DIK
  1.  ;
  1.  ;Run the "ALL" xref for field .02, file 364.7
  1.  ;  This sets the "ALL" xref based on local overrides and no ins or
  1.  ;   bill type restrictions
  1.  ;
  1.  D BMES^XPDUTL("Setting new 'ALL' xref in file 364.7.")
  1.  S DIK="^IBA(364.7,",DIK(1)=".02" D ENALL^DIK
  1.  ;
  1.  ;Run the trigger cross reference on field of file 353
  1.  ;  This sets the local screen 9's associated form
  1.  ;
  1.  D BMES^XPDUTL("Populate all SCREEN FORM PARENT FORMS field.")
  1.  S DIK="^IBE(353,",DIK(1)="2.02^1" D ENALL^DIK
  1.  ;
  1.  D COMPLETE
  1.  Q
  1.  ;
  1. MOVEMOD N IBCT,IBX,IBCP,IBMOD,IBFSPEC,DLAYGO,D0,DD,DA,DIC,DIE,DR,X,Y
  1.  ;
  1.  D BMES^XPDUTL("Moving single modifiers to multiple field, correcting mailing address zip code, adding facility name for billing")
  1.  ;
  1.  S IBFSPEC=$$GETSPEC^IBEFUNC(399.0304,16)
  1.  S IBCT=0
  1.  S IBX=+$$PARCP^XPDUTL("MOVEMOD") ;Get last bill ien processed
  1.  ;
  1.  F  S IBX=$O(^DGCR(399,IBX)) Q:'IBX  D
  1.  . N Z,IBZZ,IBZ1,IBZ,IBY,DIC,DIE,X,Y,DLAYGO,DD,DO,DR,DA
  1.  . I $P($G(^DGCR(399,IBX,"M")),U,9)["-" S X=$TR($P(^("M"),U,9),"-"),$P(^("M"),U,9)=X ; Corrects bad data in mailing address zip code field
  1.  . S IBCP=0 F  S IBCP=$O(^DGCR(399,IBX,"CP",IBCP)) Q:'IBCP  S IBMOD=+$P($G(^(IBCP,0)),U,15) D
  1.  .. I $O(^DGCR(399,IBX,"CP",IBCP,"MOD",0)) D  ; alpha sites only - add 'C' xref
  1.  ... N Z,Z0
  1.  ... S Z=0 F  S Z=$O(^DGCR(399,IBX,"CP",IBCP,"MOD",Z)) Q:'Z  I $P($G(^DGCR(399,IBX,"CP",IBCP,"MOD",Z,0)),U,2)'="" S Z0=$P(^(0),U,2),^DGCR(399,IBX,"CP",IBCP,"MOD","C",Z0,Z)=""
  1.  .. S IBCT=IBCT+1
  1.  .. S:'(IBCT#200) %=$$UPCP^XPDUTL("MOVEMOD",IBCT)
  1.  .. I 'IBMOD!$D(^DGCR(399,IBX,"CP",IBCP,"MOD","C",IBMOD)) Q
  1.  .. ;
  1.  .. ;Add the modifier to the multiple, if not already there
  1.  .. K DO,DD
  1.  .. S X=1,DIC("P")=IBFSPEC,DLAYGO=399.30416,DA(2)=IBX,DA(1)=IBCP
  1.  .. S DIC="^DGCR(399,"_IBX_",""CP"","_IBCP_",""MOD"",",DIC(0)="L"
  1.  .. S DIC("DR")=".02////"_IBMOD
  1.  .. D FILE^DICN K DO,DD,DA
  1.  .. I Y>0 S DA(1)=IBX,DA=IBCP,DR="14///@",DIE="^DGCR(399,"_DA(1)_",""CP""," D ^DIE ;Remove data from upper level if successfully added in multiple
  1.  . I $P($G(^DGCR(399,IBX,"TX")),U,2)'="" S Z=+$P(^("TX"),U,2),^DGCR(399,"ALEX",Z,IBX)=""
  1.  I $P($G(^XTMP("IB20_51","IBFAC")),U)'="" S DIE="^IBE(350.9,",DA=1,DR="2.1////"_$P(^XTMP("IB20_51","IBFAC"),U) D ^DIE
  1.  I $P($G(^XTMP("IB20_51","IBFAC")),U,2)'="" S DIE="^IBE(350.9,",DA=1,DR="2.02////"_$P(^XTMP("IB20_51","IBFAC"),U,2) D ^DIE
  1.  ;
  1.  D COMPLETE
  1.  Q
  1.  ;
  1. ERRMSG(TEXT) ; Report errors in array TEXT(error #)=text
  1.  Q:'$O(TEXT(0))
  1.  N Z,Z0
  1.  S Z0="",$P(Z0,"*",29)=""
  1.  D BMES^XPDUTL(" ")
  1.  D MES^XPDUTL(Z0_"ERROR"_Z0)
  1.  S Z=0 F  S Z=$O(TEXT(Z)) Q:'Z  D MES^XPDUTL(TEXT(Z))
  1.  D MES^XPDUTL(Z0_"*****"_Z0)
  1.  D BMES^XPDUTL(" ")
  1.  Q
  1.  ;
  1. ENT5 ; Changed and new entries from 364.5 that should be in the build
  1.  ;
  1.  ;;^LIVE^34^35^44^45^46^48^49^55^56^60^69^81^82^84^92^97^98^102^114^116^118^117^119^123^126^128^129^135^137^138^142^145^146^147^150^151^153^154^155^156^158^165^166^167^168^169^170^171^172^174^175^176^177^179^180^183^184^185^191^193^194^195^196^
  1.  ;
  1.  ;;^LIVE^197^198^199^200^201^202^204^216^220^221^231^239^241^242^243^244^245^246^247^248^249^250^251^252^255^280^258^259^260^261^263^264^265^266^267^268^269^270^271^273^274^275^276^277^278^279^281^282^285^286^287^288^289^291^293^294^295^348^
  1.  ;
  1.  ;;^LIVE^8^59^108^125^134^178^222^223^233^238^284^
  1.  ;
  1. COMPLETE ;
  1.  D BMES^XPDUTL("Step complete.")
  1.  Q
  1.  ;
  1. DD3645(Y) ;INCLUDE IN PATCH 51 BUILD
  1.  ;Y=ien of entry in file 364.5
  1.  N Z,Z0,OK
  1.  S (OK,Z)=0 F  S Z=$O(^IBA(364.7,"C",+Y,Z)) Q:'Z  S Z0=$G(^IBA(364.7,Z,0)) I $P(Z0,U,2)="N",+$G(^IBA(364.6,+Z0,0))'=8 S OK=1 Q
  1.  I $P($T(ENT5+2),";;",2)[(U_+Y_U)!($P($T(ENT5+4),";;",2)[(U_+Y_U)!($P($T(ENT5+6),";;",2)[(U_+Y_U))) S OK=1
  1.  S Z=$G(^IBA(364.5,+Y,0)) ;Reset the naked reference
  1.  Q OK
  1.  ;