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

IB20PT1.m

Go to the documentation of this file. 
  1. IB20PT1	;ALB/AAS/NLR - Insurance post init stuff ; 2/22/93
  1. 	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. 	;
  1. %	I '$O(^IBA(355.3,0)) D  ; -- one time updates (ins policy alerady exists
  1. 	.D MAIL ;      add new mail group
  1. 	.D SITE ;      update site paramters
  1. 	.D DEL ;       delete obsolete field in patient file ins. multiple
  1. 	.;D PAT ;      x-ref patient file by ins. co., add hip pointer
  1. 	.D INS ;       delete data, them dd for ins. address multiple in 36
  1. 	.;D 399 ;      add ae x-ref to file 399
  1. 	.;D INPT ;     load current inpatients into claims tracking
  1. 	.D ^IB20PT6 ;  que off patient file, bill/claims file, CT updates
  1. 	;
  1. 	Q
  1. 	;
  1. DEL	; -- delete insurance address field from insurance type multiple
  1. 	N DA,DIK,DIU,DIC
  1. 	Q:'$D(^DD(2.312,5,0))
  1. 	S DA=5,DA(1)=2.312,DIK="^DD("_DA(1)_"," D ^DIK
  1. 	W !!,"<<< Deleting Obsolete field *INSURANCE ADDRESS from Patient File Data Dictionary"
  1. DELQ	K DA,DIK,DIU
  1. 	Q
  1. 	;
  1. INS	; -- delete address subfile
  1. 	;    first delete the data
  1. 	N DIC,DIE,DA,DR,DIK,DIU
  1. 	Q:'$D(^DD(36.02,0))
  1. 	W !!,"<<< Deleting Obsolete *ADDRESS data from Insurance Company Entries"
  1. 	W !!,"    I'll write a dot for each 100 entries"
  1. 	S IBD0=0
  1. 	F  S IBD0=$O(^DIC(36,IBD0)) Q:'IBD0  S IBD1=0 F  S IBD1=$O(^DIC(36,IBD0,2,IBD1)) Q:'IBD1  D  K ^DIC(36,IBD0,2)
  1. 	.S DIK="^DIC(36,"_IBD0_",2,",DA=IBD1,DA(1)=IBD0
  1. 	.D ^DIK
  1. 	.K DA,DIC,DIK
  1. 	.S IBCNT=$G(IBCNT)+1
  1. 	.W:'(IBCNT#100) "."
  1. 	.Q
  1. 	;
  1. 	; -- Now delete the dd
  1. 	S DIU=36.02,DIU(0)="S" D EN^DIU2
  1. 	W !!,"<<< Deleting Obsolete subfile *ADDRESS from Insurance Company File Data Dictionary"
  1. INSQ	K DIU
  1. 	Q
  1. 	;
  1. PAT	; -- create AB x-ref on patient file for all insurance co. pointers
  1. 	W !!,"<<< Cross-referencing patient file by Insurance company and",!,"    Updating Health Insurance Policy Pointers"
  1. 	W !!,"    I'll write a dot for each 100 entries"
  1. 	D NOW^%DTC W !,"    Start time: " S Y=% D DT^DIQ
  1. 	N DFN,IBI,IBCPOL,IBCDFND,DA,DR,DIE,DIC,IBCNT,IBCNTP,IBCNTPP
  1. 	S (IBCNT,IBCNTP,IBCNTPP,DFN)=0
  1. 	F  S DFN=$O(^DPT(DFN)) Q:'DFN  S IBCNT=IBCNT+1,IBI=0 F  S IBI=$O(^DPT(DFN,.312,IBI)) Q:'IBI  D
  1. 	.W:'(IBCNTPP#100) "."
  1. 	.S IBCDFND=$G(^DPT(DFN,.312,IBI,0))
  1. 	.S ^DPT("AB",+IBCDFND,DFN,IBI)=""
  1. 	.S ^DPT(DFN,.312,"B",+IBCDFND,IBI)=""
  1. 	.Q:$P(IBCDFND,U,18)
  1. 	.S IBCPOL=$$CHIP^IBCNSU(IBCDFND)
  1. 	.Q:'IBCPOL
  1. 	.S IBCNTPP=IBCNTPP+1
  1. 	.S DA=IBI,DA(1)=DFN,DIE="^DPT("_DFN_",.312,"
  1. 	.S DR="1.09////1;.18////"_IBCPOL
  1. 	.D ^DIE K DA,DR,DIE,DIC
  1. 	.Q
  1. 	W !!,"<<< Health Insurance Policy information updated"
  1. 	W !,"    there were ",IBCNTPP," Policies for ",IBCNT," Patients were updated"
  1. 	W !,"    causing ",IBCNTP," Health Insurance Policies to be added"
  1. 	D NOW^%DTC W !,"    Finish Time: " S Y=% D DT^DIQ
  1. 	Q
  1. 	;
  1. 399	; -- create new AE x-ref of file 399
  1. 	N IBCIFN,IBCNT
  1. 	W !!,"<<< Cross-referencing Bill/Claims file by Primary Insurer"
  1. 	W !!,"    I'll write a dot for each 100 entries"
  1. 	S IBCIFN=0,IBCNT=0
  1. 	F  S IBCIFN=$O(^DGCR(399,IBCIFN)) Q:'IBCIFN  D
  1. 	.I +$G(^DGCR(399,IBCIFN,"M")),$P($G(^(0)),"^",2) S ^DGCR(399,"AE",$P(^(0),"^",2),+^("M"),IBCIFN)=""
  1. 	.S IBCNT=$G(IBCNT)+1 W:'(IBCNT#100) "."
  1. 	Q
  1. 	;
  1. INPT	; -- load current inpatients into claims tracking
  1. 	W !!,"<<< Loading current inpatients into Claims Tracking"
  1. 	N WARD,DGPMDA,IBCNT,IB20
  1. 	S WARD="",DGPDMA=0,IBCNT=0,IB20=1
  1. 	F  S WARD=$O(^DGPM("CN",WARD)) Q:WARD=""  S DGPMDA=0 F  S DGPMDA=$O(^DGPM("CN",WARD,DGPMDA)) Q:'DGPMDA  D
  1. 	.S DGPMP=""
  1. 	.S DGPMA=$G(^DGPM(DGPMDA,0))
  1. 	.S DFN=$P(DGPMA,"^",3)
  1. 	.D INP^VADPT
  1. 	.K IBNEW D INP^IBTRKR
  1. 	.I $G(IBNEW) S IBCNT=IBCNT+1 W !,"    Patient ",$P(^DPT(DFN,0),U)," added to the Claims tracking module"
  1. 	;
  1. 	W !!,"<<< ",IBCNT," Patients added to the Claims Tracking Module"
  1. 	Q
  1. 	;
  1. MAIL	; -- add new mail group
  1. 	;Q:$D(^XMB(3.8,"B","IB NEW INSURANCE"))
  1. 	S DLAYGO=3.8,DIC="^XMB(3.8,",DIC(0)="LX",DIC("DR")="4////PU;5////"_DUZ,X="IB NEW INSURANCE" D ^DIC K DIC I +Y>0 S IBCNMAIL=+Y
  1. 	S ^XMB(3.8,+Y,2,0)="^^1^1^2900625^"
  1. 	S ^XMB(3.8,+Y,2,1,0)="This mail group will receive notification whenever a new insurance policy is added."
  1. 	W !!,"<<< Mail Group 'IB NEW INSURANCE' ",$S($P(Y,"^",3):"added...",1:"updated...")
  1. 	W !!,"    Remember to add Members to this group"
  1. 	Q
  1. 	;
  1. SITE	; -- setup ib site parameters
  1. 	N DIE,DA,DR,DIC,DD,DO S DR=""
  1. 	W !!,"<<< Updating new site parameters automatically!"
  1. 	;
  1. 	; -- if no entry add one
  1. 	I '$D(^IBE(350.9,1,0)) S (X,DINUM)=1,DIC="^IBE(350.9,",DIC(0)="L" K DD,DO D FILE^DICN K DIC S DR=".03///1;.02////^S X=+$$SITE^VASITE;.08///2;.09///IB ERROR;",DA=1,DIE="^IBE(350.9," D ^DIE K DR,DA,DIE,DIC
  1. 	;
  1. 	S DA=1,DIE="^IBE(350.9,"
  1. 	S DR="4.01////1;4.04////"_$G(IBCNMAIL)_";6.01///^S X=DT;6.02////1;6.02////1;6.03////1;6.04////1;6.05////1;6.06////1;6.07///^S X=DT;6.08////1;6.09////5;6.13////1;6.14////5;6.18////1;6.19////1"
  1. 	D ^DIE K DIE,DA,DR,DIC,DD,DO W !
  1. 	Q