- IBTRE20 ;ALB/AAS - CLAIMS TRACKING EXECUTABLE HELP ; 13-OCT-93
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ;
- LISTA ; -- list inpatient admissions for patient
- N C,I,J,N,X,Y,IBX
- K ^TMP("IBM",$J)
- Q:'$D(DFN)
- S C=0 F I=0:0 S I=$O(^DGPM("ATID1",DFN,I)) Q:'I S N=$O(^(I,0)) I $D(^DGPM(+N,0)) S D=^(0),C=C+1,^TMP("IBM",$J,C)=N_"^"_D
- ;
- I C=0 W !!,"No Admissions to Choose From." Q
- ;
- W !!,"CHOOSE FROM:" F IBI=1:1:10 Q:'$D(^TMP("IBM",$J,IBI)) D WRA
- K ^TMP("IBM",$J)
- Q
- ;
- WRA S IBX=$P(^TMP("IBM",$J,IBI),"^",2,20),Y=+IBX X ^DD("DD")
- W !," ",Y
- W ?27,$S('$D(^DG(405.1,+$P(IBX,"^",4),0)):"",$P(^(0),"^",7)]"":$P(^(0),"^",7),1:$E($P(^(0),"^",1),1,20))
- ;
- W ?50,"TO: ",$E($P($G(^DIC(42,+$P(IBX,"^",6),0)),"^"),1,17)
- I $D(^DG(405.4,+$P(IBX,"^",7),0)) W " [",$E($P(^(0),"^",1),1,10),"]"
- I $P(IBX,"^",18)=9 W !?23,"FROM: ",$P($G(^DIC(4,+$P(IBX,"^",5),0)),"^")
- Q
- ;
- LISTO ; -- list outpatient appointments
- N C,I,J,N,X,Y,IBX,IBI
- K ^TMP("IBM",$J)
- Q:'$D(DFN)
- S C=0 S I=$G(IBTBDT) F S I=$O(^DPT(DFN,"S",I)) Q:'I!(I>(IBTEDT+.24)) I $D(^DPT(DFN,"S",I,0)) S D=^(0),C=C+1,^TMP("IBM",$J,C)=I_"^"_D
- ;
- I C=0 W !!,"No Outpatient Visits to Choose From." Q
- ;
- W !!,"CHOOSE FROM:" F IBI=1:1:12 Q:'$D(^TMP("IBM",$J,IBI)) D WRO
- K ^TMP("IBM",$J)
- Q
- ;
- WRO S IBX=$G(^TMP("IBM",$J,IBI)),Y=+IBX,IBX=$P(IBX,"^",2,99) X ^DD("DD")
- W !," ",Y
- W ?27,"Clinic: ",$P($G(^SC(+IBX,0)),"^"),?60," Type: ",$E($P($G(^SD(409.1,+$P(IBX,"^",16),0)),"^"),1,12)
- ;
- I $P(IBX,"^",2)]"" W !,?10," [Status: ",$$EXPAND^IBTRE(2.98,3,$P(IBX,"^",2)),"]"
- Q
- LISTS ; -- list scheduled admissions
- N C,I,J,N,X,Y,IBX,IBI
- K ^TMP("IBM",$J)
- Q:'$D(DFN)
- S C=0 F I=0:0 S I=$O(^DGS(41.1,"B",DFN,I)) Q:'I I $D(^DGS(41.1,+I,0)) S D=$G(^DGS(41.1,+I,0)) I $P(D,"^",2)'<IBTBDT,$P(D,"^",2)'>IBTEDT S C=C+1,^TMP("IBM",$J,C)=I_"^"_D
- ;
- I C=0 W !!,"No Scheduled Admissions to Choose From." Q
- ;
- W !!,"CHOOSE FROM:" F IBI=1:1:12 Q:'$D(^TMP("IBM",$J,IBI)) D WRS
- K ^TMP("IBM",$J)
- Q
- ;
- WRS S IBX=$P($G(^TMP("IBM",$J,IBI)),"^",2,20),Y=$P(IBX,"^",2) X ^DD("DD")
- W !," ",Y
- W ?27," Spec: ",$E($P($G(^DIC(45.7,+$P(IBX,"^",9),0)),"^"),1,25)
- ;
- W ?58," To: ",$E($P($G(^DIC(42,+$P(IBX,"^",8),0)),"^"),1,16)
- Q
- ;
- FINDS ; -- match a scheduled admission
- Q:'$D(DFN)
- Q:'$D(IBTDT)
- N I,J
- S I=0 F S I=$O(^DGS(41.1,"B",DFN,I)) Q:'I S J=$P($G(^DGS(41.1,I,0)),"^",2) Q:IBTDT=J I $P(IBTDT,".")=$P(J,".") S IBTDT=J Q
- Q
- ;
- ID ; -- write out identifier for entry, called by ^dd(356,0,"id","write")
- N IBOE
- S IBOE=$P(^(0),"^",4) I IBOE,$P($G(^SCE(+IBOE,0)),"^",4) W ?58,"["_$E($P($G(^SC(+$P($G(^SCE(+IBOE,0)),"^",4),0)),"^"),1,20),"]"
- Q
- IBTRE20 ;ALB/AAS - CLAIMS TRACKING EXECUTABLE HELP ; 13-OCT-93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ;
- LISTA ; -- list inpatient admissions for patient
- +1 NEW C,I,J,N,X,Y,IBX
- +2 KILL ^TMP("IBM",$JOB)
- +3 IF '$DATA(DFN)
- QUIT
- +4 SET C=0
- FOR I=0:0
- SET I=$ORDER(^DGPM("ATID1",DFN,I))
- IF 'I
- QUIT
- SET N=$ORDER(^(I,0))
- IF $DATA(^DGPM(+N,0))
- SET D=^(0)
- SET C=C+1
- SET ^TMP("IBM",$JOB,C)=N_"^"_D
- +5 ;
- +6 IF C=0
- WRITE !!,"No Admissions to Choose From."
- QUIT
- +7 ;
- +8 WRITE !!,"CHOOSE FROM:"
- FOR IBI=1:1:10
- IF '$DATA(^TMP("IBM",$JOB,IBI))
- QUIT
- DO WRA
- +9 KILL ^TMP("IBM",$JOB)
- +10 QUIT
- +11 ;
- WRA SET IBX=$PIECE(^TMP("IBM",$JOB,IBI),"^",2,20)
- SET Y=+IBX
- XECUTE ^DD("DD")
- +1 WRITE !," ",Y
- +2 WRITE ?27,$SELECT('$DATA(^DG(405.1,+$PIECE(IBX,"^",4),0)):"",$PIECE(^(0),"^",7)]"":$PIECE(^(0),"^",7),1:$EXTRACT($PIECE(^(0),"^",1),1,20))
- +3 ;
- +4 WRITE ?50,"TO: ",$EXTRACT($PIECE($GET(^DIC(42,+$PIECE(IBX,"^",6),0)),"^"),1,17)
- +5 IF $DATA(^DG(405.4,+$PIECE(IBX,"^",7),0))
- WRITE " [",$EXTRACT($PIECE(^(0),"^",1),1,10),"]"
- +6 IF $PIECE(IBX,"^",18)=9
- WRITE !?23,"FROM: ",$PIECE($GET(^DIC(4,+$PIECE(IBX,"^",5),0)),"^")
- +7 QUIT
- +8 ;
- LISTO ; -- list outpatient appointments
- +1 NEW C,I,J,N,X,Y,IBX,IBI
- +2 KILL ^TMP("IBM",$JOB)
- +3 IF '$DATA(DFN)
- QUIT
- +4 SET C=0
- SET I=$GET(IBTBDT)
- FOR
- SET I=$ORDER(^DPT(DFN,"S",I))
- IF 'I!(I>(IBTEDT+.24))
- QUIT
- IF $DATA(^DPT(DFN,"S",I,0))
- SET D=^(0)
- SET C=C+1
- SET ^TMP("IBM",$JOB,C)=I_"^"_D
- +5 ;
- +6 IF C=0
- WRITE !!,"No Outpatient Visits to Choose From."
- QUIT
- +7 ;
- +8 WRITE !!,"CHOOSE FROM:"
- FOR IBI=1:1:12
- IF '$DATA(^TMP("IBM",$JOB,IBI))
- QUIT
- DO WRO
- +9 KILL ^TMP("IBM",$JOB)
- +10 QUIT
- +11 ;
- WRO SET IBX=$GET(^TMP("IBM",$JOB,IBI))
- SET Y=+IBX
- SET IBX=$PIECE(IBX,"^",2,99)
- XECUTE ^DD("DD")
- +1 WRITE !," ",Y
- +2 WRITE ?27,"Clinic: ",$PIECE($GET(^SC(+IBX,0)),"^"),?60," Type: ",$EXTRACT($PIECE($GET(^SD(409.1,+$PIECE(IBX,"^",16),0)),"^"),1,12)
- +3 ;
- +4 IF $PIECE(IBX,"^",2)]""
- WRITE !,?10," [Status: ",$$EXPAND^IBTRE(2.98,3,$PIECE(IBX,"^",2)),"]"
- +5 QUIT
- LISTS ; -- list scheduled admissions
- +1 NEW C,I,J,N,X,Y,IBX,IBI
- +2 KILL ^TMP("IBM",$JOB)
- +3 IF '$DATA(DFN)
- QUIT
- +4 SET C=0
- FOR I=0:0
- SET I=$ORDER(^DGS(41.1,"B",DFN,I))
- IF 'I
- QUIT
- IF $DATA(^DGS(41.1,+I,0))
- SET D=$GET(^DGS(41.1,+I,0))
- IF $PIECE(D,"^",2)'<IBTBDT
- IF $PIECE(D,"^",2)'>IBTEDT
- SET C=C+1
- SET ^TMP("IBM",$JOB,C)=I_"^"_D
- +5 ;
- +6 IF C=0
- WRITE !!,"No Scheduled Admissions to Choose From."
- QUIT
- +7 ;
- +8 WRITE !!,"CHOOSE FROM:"
- FOR IBI=1:1:12
- IF '$DATA(^TMP("IBM",$JOB,IBI))
- QUIT
- DO WRS
- +9 KILL ^TMP("IBM",$JOB)
- +10 QUIT
- +11 ;
- WRS SET IBX=$PIECE($GET(^TMP("IBM",$JOB,IBI)),"^",2,20)
- SET Y=$PIECE(IBX,"^",2)
- XECUTE ^DD("DD")
- +1 WRITE !," ",Y
- +2 WRITE ?27," Spec: ",$EXTRACT($PIECE($GET(^DIC(45.7,+$PIECE(IBX,"^",9),0)),"^"),1,25)
- +3 ;
- +4 WRITE ?58," To: ",$EXTRACT($PIECE($GET(^DIC(42,+$PIECE(IBX,"^",8),0)),"^"),1,16)
- +5 QUIT
- +6 ;
- FINDS ; -- match a scheduled admission
- +1 IF '$DATA(DFN)
- QUIT
- +2 IF '$DATA(IBTDT)
- QUIT
- +3 NEW I,J
- +4 SET I=0
- FOR
- SET I=$ORDER(^DGS(41.1,"B",DFN,I))
- IF 'I
- QUIT
- SET J=$PIECE($GET(^DGS(41.1,I,0)),"^",2)
- IF IBTDT=J
- QUIT
- IF $PIECE(IBTDT,".")=$PIECE(J,".")
- SET IBTDT=J
- QUIT
- +5 QUIT
- +6 ;
- ID ; -- write out identifier for entry, called by ^dd(356,0,"id","write")
- +1 NEW IBOE
- +2 SET IBOE=$PIECE(^(0),"^",4)
- IF IBOE
- IF $PIECE($GET(^SCE(+IBOE,0)),"^",4)
- WRITE ?58,"["_$EXTRACT($PIECE($GET(^SC(+$PIECE($GET(^SCE(+IBOE,0)),"^",4),0)),"^"),1,20),"]"
- +3 QUIT
