- IB20PT6 ;ALB/AAS - Insurance post init stuff ; 2/22/93
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;
- % S IBFORCE=1
- I '$O(^IBA(355.3,0)) D ; -- one time updates (ins policy alerady exists
- .D PAT ; x-ref patient file by ins. co., add hip pointer
- .D 399^IB20PT61 ; add ae x-ref to file 399
- .D INPT ; load current inpatients into claims tracking
- ;
- K IBFORCE
- Q
- ;
- PAT ; -- create AB x-ref on patient file for all insurance co. pointers
- W !!!,"<<< Patient file insurance conversion"
- W !," Cross-reference patient file by Insurance company and",!," Update Health Insurance Policy Pointers"
- S ZTRTN="PATDQ^IB20PT6",ZTDESC="IB - v2 PATIENT FILE POST INIT UPDATE",ZTIO="" S:$G(IBFORCE) ZTDTH=$$15
- W ! D ^%ZTLOAD I '$D(ZTSK) D Q:'IBOK
- .D MANUAL^IB20PT61
- .I 'IBOK,$P($G(^IBE(350.9,1,3)),"^",18)="" W !!,"You must run the v2.0 post init routine IB20PT6 before allowing users to",!,"edit insurance information"
- I $D(ZTSK) W !," Patient file update queued as task ",ZTSK K ZTSK Q
- ;
- PATDQ D NOW^%DTC S IBSPDT=%
- I '$D(ZTQUEUED) D
- .W !!," I'll write a dot for each 100 entries"
- .W !," Start time: " S Y=IBSPDT D DT^DIQ
- N DFN,IBI,IBCPOL,IBCDFND,DA,DR,DIE,DIC,IBCNT,IBCNTP,IBCNTPP,IBCNTI
- S (IBCNT,IBCNTP,IBCNTPP,IBCNTI,DFN)=0
- F S DFN=$O(^DPT(DFN)) Q:'DFN S IBCNT=IBCNT+1,IBI=0 S:$O(^DPT(DFN,.312,IBI)) IBCNTI=IBCNTI+1 F S IBI=$O(^DPT(DFN,.312,IBI)) Q:'IBI D
- .I '$D(ZTQUEUED) W:'(IBCNTPP#100) "."
- .S IBCDFND=$G(^DPT(DFN,.312,IBI,0))
- .S ^DPT("AB",+IBCDFND,DFN,IBI)=""
- .S ^DPT(DFN,.312,"B",+IBCDFND,IBI)=""
- .Q:$P(IBCDFND,U,18)
- .S IBCPOL=$$CHIP^IBCNSU(IBCDFND)
- .Q:'IBCPOL
- .Q:+IBCDFND'=+$G(^IBA(355.3,+IBCPOL,0)) ; patient ins. and policy must have same ins. company file.
- .S IBCNTPP=IBCNTPP+1
- .S DA=IBI,DA(1)=DFN,DIE="^DPT("_DFN_",.312,"
- .S DR="1.09////1;.18////"_IBCPOL
- .D ^DIE K DA,DR,DIE,DIC
- .Q
- S $P(^IBE(350.9,1,3),"^",18)=DT
- D NOW^%DTC S IBEPDT=%
- D BULL1^IB20PT61
- I '$D(ZTQUEUED) D
- .W !!,"<<< Health Insurance Policy information updated"
- .W !," there were ",IBCNTPP," Policies for ",IBCNT," Patients were updated"
- .W !," causing ",IBCNTP," Health Insurance Policies to be added"
- .W !," Finish Time: " S Y=IBEPDT D DT^DIQ
- Q
- ;
- ;
- INPT ; -- load current inpatients into claims tracking
- W !!!,"<<< Load current inpatients into Claims Tracking"
- S ZTRTN="INPTDQ^IB20PT6",ZTDESC="IB - v2 CLAIMS TRACKING POST INIT UPDATE",ZTIO="" S:$G(IBFORCE) ZTDTH=$$15
- W ! D ^%ZTLOAD I '$D(ZTSK) D Q:'IBOK
- .D MANUAL^IB20PT61
- .I 'IBOK,$P($G(^IBE(350.9,1,3)),"^",20)="" W !!,"You must run the v2.0 post init routine IB20PT6 to automatically add",!,"Current inpatient into Claims Tracking."
- I $D(ZTSK) W !," Claims Tracking update queued as task ",ZTSK K ZTSK Q
- ;
- INPTDQ D NOW^%DTC S IBSTDT=%
- N WARD,DGPMDA,IBCNT,IB20
- S WARD="",DGPDMA=0,IBCNT=0,IB20=1
- F S WARD=$O(^DGPM("CN",WARD)) Q:WARD="" S DGPMDA=0 F S DGPMDA=$O(^DGPM("CN",WARD,DGPMDA)) Q:'DGPMDA D
- .S DGPMP=""
- .S DGPMA=$G(^DGPM(DGPMDA,0)) Q:DGPMA=""
- .S DFN=$P(DGPMA,"^",3) Q:'DFN
- .D INP^VADPT
- .K IBNEW D INP^IBTRKR
- .I $G(IBNEW) S IBCNT=IBCNT+1 I '$D(ZTQUEUED) W !," Patient ",$P(^DPT(DFN,0),U)," added to the Claims tracking module"
- ;
- I '$D(ZTQUEUED) W !!,"<<< ",IBCNT," Patients added to the Claims Tracking Module"
- D NOW^%DTC S IBETDT=%
- D BULL3^IB20PT61
- S $P(^IBE(350.9,1,3),"^",20)=DT
- Q
- ;
- 15() ; -- Add 15 minutes to now and return in $h format
- Q $P($H,",")_","_($P($H,",",2)+(15*60))
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20PT6 3519 printed Apr 23, 2025@18:19:54 Page 2
- IB20PT6 ;ALB/AAS - Insurance post init stuff ; 2/22/93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;
- % SET IBFORCE=1
- +1 ; -- one time updates (ins policy alerady exists
- IF '$ORDER(^IBA(355.3,0))
- Begin DoDot:1
- +2 ; x-ref patient file by ins. co., add hip pointer
- DO PAT
- +3 ; add ae x-ref to file 399
- DO 399^IB20PT61
- +4 ; load current inpatients into claims tracking
- DO INPT
- End DoDot:1
- +5 ;
- +6 KILL IBFORCE
- +7 QUIT
- +8 ;
- PAT ; -- create AB x-ref on patient file for all insurance co. pointers
- +1 WRITE !!!,"<<< Patient file insurance conversion"
- +2 WRITE !," Cross-reference patient file by Insurance company and",!," Update Health Insurance Policy Pointers"
- +3 SET ZTRTN="PATDQ^IB20PT6"
- SET ZTDESC="IB - v2 PATIENT FILE POST INIT UPDATE"
- SET ZTIO=""
- if $GET(IBFORCE)
- SET ZTDTH=$$15
- +4 WRITE !
- DO ^%ZTLOAD
- IF '$DATA(ZTSK)
- Begin DoDot:1
- +5 DO MANUAL^IB20PT61
- +6 IF 'IBOK
- IF $PIECE($GET(^IBE(350.9,1,3)),"^",18)=""
- WRITE !!,"You must run the v2.0 post init routine IB20PT6 before allowing users to",!,"edit insurance information"
- End DoDot:1
- if 'IBOK
- QUIT
- +7 IF $DATA(ZTSK)
- WRITE !," Patient file update queued as task ",ZTSK
- KILL ZTSK
- QUIT
- +8 ;
- PATDQ DO NOW^%DTC
- SET IBSPDT=%
- +1 IF '$DATA(ZTQUEUED)
- Begin DoDot:1
- +2 WRITE !!," I'll write a dot for each 100 entries"
- +3 WRITE !," Start time: "
- SET Y=IBSPDT
- DO DT^DIQ
- End DoDot:1
- +4 NEW DFN,IBI,IBCPOL,IBCDFND,DA,DR,DIE,DIC,IBCNT,IBCNTP,IBCNTPP,IBCNTI
- +5 SET (IBCNT,IBCNTP,IBCNTPP,IBCNTI,DFN)=0
- +6 FOR
- SET DFN=$ORDER(^DPT(DFN))
- if 'DFN
- QUIT
- SET IBCNT=IBCNT+1
- SET IBI=0
- if $ORDER(^DPT(DFN,.312,IBI))
- SET IBCNTI=IBCNTI+1
- FOR
- SET IBI=$ORDER(^DPT(DFN,.312,IBI))
- if 'IBI
- QUIT
- Begin DoDot:1
- +7 IF '$DATA(ZTQUEUED)
- if '(IBCNTPP#100)
- WRITE "."
- +8 SET IBCDFND=$GET(^DPT(DFN,.312,IBI,0))
- +9 SET ^DPT("AB",+IBCDFND,DFN,IBI)=""
- +10 SET ^DPT(DFN,.312,"B",+IBCDFND,IBI)=""
- +11 if $PIECE(IBCDFND,U,18)
- QUIT
- +12 SET IBCPOL=$$CHIP^IBCNSU(IBCDFND)
- +13 if 'IBCPOL
- QUIT
- +14 ; patient ins. and policy must have same ins. company file.
- if +IBCDFND'=+$GET(^IBA(355.3,+IBCPOL,0))
- QUIT
- +15 SET IBCNTPP=IBCNTPP+1
- +16 SET DA=IBI
- SET DA(1)=DFN
- SET DIE="^DPT("_DFN_",.312,"
- +17 SET DR="1.09////1;.18////"_IBCPOL
- +18 DO ^DIE
- KILL DA,DR,DIE,DIC
- +19 QUIT
- End DoDot:1
- +20 SET $PIECE(^IBE(350.9,1,3),"^",18)=DT
- +21 DO NOW^%DTC
- SET IBEPDT=%
- +22 DO BULL1^IB20PT61
- +23 IF '$DATA(ZTQUEUED)
- Begin DoDot:1
- +24 WRITE !!,"<<< Health Insurance Policy information updated"
- +25 WRITE !," there were ",IBCNTPP," Policies for ",IBCNT," Patients were updated"
- +26 WRITE !," causing ",IBCNTP," Health Insurance Policies to be added"
- +27 WRITE !," Finish Time: "
- SET Y=IBEPDT
- DO DT^DIQ
- End DoDot:1
- +28 QUIT
- +29 ;
- +30 ;
- INPT ; -- load current inpatients into claims tracking
- +1 WRITE !!!,"<<< Load current inpatients into Claims Tracking"
- +2 SET ZTRTN="INPTDQ^IB20PT6"
- SET ZTDESC="IB - v2 CLAIMS TRACKING POST INIT UPDATE"
- SET ZTIO=""
- if $GET(IBFORCE)
- SET ZTDTH=$$15
- +3 WRITE !
- DO ^%ZTLOAD
- IF '$DATA(ZTSK)
- Begin DoDot:1
- +4 DO MANUAL^IB20PT61
- +5 IF 'IBOK
- IF $PIECE($GET(^IBE(350.9,1,3)),"^",20)=""
- WRITE !!,"You must run the v2.0 post init routine IB20PT6 to automatically add",!,"Current inpatient into Claims Tracking."
- End DoDot:1
- if 'IBOK
- QUIT
- +6 IF $DATA(ZTSK)
- WRITE !," Claims Tracking update queued as task ",ZTSK
- KILL ZTSK
- QUIT
- +7 ;
- INPTDQ DO NOW^%DTC
- SET IBSTDT=%
- +1 NEW WARD,DGPMDA,IBCNT,IB20
- +2 SET WARD=""
- SET DGPDMA=0
- SET IBCNT=0
- SET IB20=1
- +3 FOR
- SET WARD=$ORDER(^DGPM("CN",WARD))
- if WARD=""
- QUIT
- SET DGPMDA=0
- FOR
- SET DGPMDA=$ORDER(^DGPM("CN",WARD,DGPMDA))
- if 'DGPMDA
- QUIT
- Begin DoDot:1
- +4 SET DGPMP=""
- +5 SET DGPMA=$GET(^DGPM(DGPMDA,0))
- if DGPMA=""
- QUIT
- +6 SET DFN=$PIECE(DGPMA,"^",3)
- if 'DFN
- QUIT
- +7 DO INP^VADPT
- +8 KILL IBNEW
- DO INP^IBTRKR
- +9 IF $GET(IBNEW)
- SET IBCNT=IBCNT+1
- IF '$DATA(ZTQUEUED)
- WRITE !," Patient ",$PIECE(^DPT(DFN,0),U)," added to the Claims tracking module"
- End DoDot:1
- +10 ;
- +11 IF '$DATA(ZTQUEUED)
- WRITE !!,"<<< ",IBCNT," Patients added to the Claims Tracking Module"
- +12 DO NOW^%DTC
- SET IBETDT=%
- +13 DO BULL3^IB20PT61
- +14 SET $PIECE(^IBE(350.9,1,3),"^",20)=DT
- +15 QUIT
- +16 ;
- 15() ; -- Add 15 minutes to now and return in $h format
- +1 QUIT $PIECE($HOROLOG,",")_","_($PIECE($HOROLOG,",",2)+(15*60))
