- IBTRKR2 ;ALB/AAS - ADD/TRACK SCHEDULED ADMISSION ;9-AUG-93
- ;;2.0;INTEGRATED BILLING;**43,62,214,312**;21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- % ;
- EN ; -- add scheduled admissions to claims tracking file
- N I,J,X,Y,IBTRKR,IBI,IBJ,DFN,IBDATA
- N IBSWINFO S IBSWINFO=$$SWSTAT^IBBAPI() ;IB*2.0*312
- S IBTRKR=$G(^IBE(350.9,1,6))
- G:'$P(IBTRKR,"^",2) ENQ ; inpatient tracking off
- S:'$G(IBTSBDT) IBTSBDT=$$FMADD^XLFDT(DT,-3)-.1
- S:'$G(IBTSEDT) IBTSEDT=$$FMADD^XLFDT(DT,7)+.9
- I IBTSBDT<+IBTRKR S IBTSBDT=+IBTRKR-.1 ; start date can't be before ct start date
- S IBI=IBTSBDT-.0001
- F S IBI=$O(^DGS(41.1,"C",IBI)) Q:'IBI!(IBI>IBTSEDT) S IBJ="" F S IBJ=$O(^DGS(41.1,"C",IBI,IBJ)) Q:'IBJ D
- .;
- .;Do NOT PROCESS on VistA if IBI/Sched DT>=Switch Eff Dt ;CCR-930
- .I +IBSWINFO,(IBI+1)>$P(IBSWINFO,"^",2) Q ;IB*2.0*312
- .;
- .S IBDATA=$G(^DGS(41.1,IBJ,0))
- .S DFN=+IBDATA
- .Q:'DFN ; no patient
- .Q:$P(IBDATA,"^",17) ; already admitted
- .;
- .S IBTRN=$O(^IBT(356,"ASCH",IBJ,0))
- .I $P(IBDATA,"^",13) D:IBTRN INACTIVE^IBTRKRU(IBTRN) Q ; canceled
- .;
- .; - if not in ct add
- .I 'IBTRN D Q
- ..I $P(IBTRKR,"^",2)=2 D SCH^IBTUTL2(DFN,IBI,IBJ) Q
- ..I $P(IBTRKR,"^",2)=1,$S('$$INSURED^IBCNS1(DFN,+IBI):0,1:$$PTCOV^IBCNSU3(DFN,+IBI,"INPATIENT")) D SCH^IBTUTL2(DFN,IBI,IBJ) Q
- ..D TRKR^IBCNRDV(DFN,IBI,IBJ,$P(IBDATA,"^",11))
- ..Q
- .;
- .; - if inactive re-activate
- .I '$P(^IBT(356,+IBTRN,0),"^",20) D
- ..N X,Y,I,J,DA,DR,DIE,DIC
- ..S DA=IBTRN,DR=".2////1",DIE="^IBT(356," D ^DIE
- .Q
- ;
- ENQ K IBTSEDT,IBTSBDT
- ; add cleanup of ARDV
- S X=0 F S X=$O(^IBT(356,"ARDV",X)) Q:X<1 S Y=0 F S Y=$O(^IBT(356,"ARDV",X,Y)) Q:Y<1 I Y<DT K ^IBT(356,"ARDV",X,Y)
- Q
- ;
- SCH(DGPMCA) ; -- is this admission movement a scheduled admission
- ; -- output scheduled admission pointer
- ;
- N IBTSA S IBTSA=0
- I '$G(DGPMCA) G SCHQ
- S IBTSA=+$O(^DGS(41.1,"AMVT",DGPMCA,0))
- SCHQ Q IBTSA
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRKR2 1972 printed Jan 18, 2025@03:29:49 Page 2
- IBTRKR2 ;ALB/AAS - ADD/TRACK SCHEDULED ADMISSION ;9-AUG-93
- +1 ;;2.0;INTEGRATED BILLING;**43,62,214,312**;21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- % ;
- EN ; -- add scheduled admissions to claims tracking file
- +1 NEW I,J,X,Y,IBTRKR,IBI,IBJ,DFN,IBDATA
- +2 ;IB*2.0*312
- NEW IBSWINFO
- SET IBSWINFO=$$SWSTAT^IBBAPI()
- +3 SET IBTRKR=$GET(^IBE(350.9,1,6))
- +4 ; inpatient tracking off
- if '$PIECE(IBTRKR,"^",2)
- GOTO ENQ
- +5 if '$GET(IBTSBDT)
- SET IBTSBDT=$$FMADD^XLFDT(DT,-3)-.1
- +6 if '$GET(IBTSEDT)
- SET IBTSEDT=$$FMADD^XLFDT(DT,7)+.9
- +7 ; start date can't be before ct start date
- IF IBTSBDT<+IBTRKR
- SET IBTSBDT=+IBTRKR-.1
- +8 SET IBI=IBTSBDT-.0001
- +9 FOR
- SET IBI=$ORDER(^DGS(41.1,"C",IBI))
- if 'IBI!(IBI>IBTSEDT)
- QUIT
- SET IBJ=""
- FOR
- SET IBJ=$ORDER(^DGS(41.1,"C",IBI,IBJ))
- if 'IBJ
- QUIT
- Begin DoDot:1
- +10 ;
- +11 ;Do NOT PROCESS on VistA if IBI/Sched DT>=Switch Eff Dt ;CCR-930
- +12 ;IB*2.0*312
- IF +IBSWINFO
- IF (IBI+1)>$PIECE(IBSWINFO,"^",2)
- QUIT
- +13 ;
- +14 SET IBDATA=$GET(^DGS(41.1,IBJ,0))
- +15 SET DFN=+IBDATA
- +16 ; no patient
- if 'DFN
- QUIT
- +17 ; already admitted
- if $PIECE(IBDATA,"^",17)
- QUIT
- +18 ;
- +19 SET IBTRN=$ORDER(^IBT(356,"ASCH",IBJ,0))
- +20 ; canceled
- IF $PIECE(IBDATA,"^",13)
- if IBTRN
- DO INACTIVE^IBTRKRU(IBTRN)
- QUIT
- +21 ;
- +22 ; - if not in ct add
- +23 IF 'IBTRN
- Begin DoDot:2
- +24 IF $PIECE(IBTRKR,"^",2)=2
- DO SCH^IBTUTL2(DFN,IBI,IBJ)
- QUIT
- +25 IF $PIECE(IBTRKR,"^",2)=1
- IF $SELECT('$$INSURED^IBCNS1(DFN,+IBI):0,1:$$PTCOV^IBCNSU3(DFN,+IBI,"INPATIENT"))
- DO SCH^IBTUTL2(DFN,IBI,IBJ)
- QUIT
- +26 DO TRKR^IBCNRDV(DFN,IBI,IBJ,$PIECE(IBDATA,"^",11))
- +27 QUIT
- End DoDot:2
- QUIT
- +28 ;
- +29 ; - if inactive re-activate
- +30 IF '$PIECE(^IBT(356,+IBTRN,0),"^",20)
- Begin DoDot:2
- +31 NEW X,Y,I,J,DA,DR,DIE,DIC
- +32 SET DA=IBTRN
- SET DR=".2////1"
- SET DIE="^IBT(356,"
- DO ^DIE
- End DoDot:2
- +33 QUIT
- End DoDot:1
- +34 ;
- ENQ KILL IBTSEDT,IBTSBDT
- +1 ; add cleanup of ARDV
- +2 SET X=0
- FOR
- SET X=$ORDER(^IBT(356,"ARDV",X))
- if X<1
- QUIT
- SET Y=0
- FOR
- SET Y=$ORDER(^IBT(356,"ARDV",X,Y))
- if Y<1
- QUIT
- IF Y<DT
- KILL ^IBT(356,"ARDV",X,Y)
- +3 QUIT
- +4 ;
- SCH(DGPMCA) ; -- is this admission movement a scheduled admission
- +1 ; -- output scheduled admission pointer
- +2 ;
- +3 NEW IBTSA
- SET IBTSA=0
- +4 IF '$GET(DGPMCA)
- GOTO SCHQ
- +5 SET IBTSA=+$ORDER(^DGS(41.1,"AMVT",DGPMCA,0))
- SCHQ QUIT IBTSA