IBATLM2B.m

IBATLM2B ;LL/ELZ - TRANSFER PRICING PT TRANSACTION DETAIL ; 15-SEP-1998

 ;;2.0;INTEGRATED BILLING;**115,266**;21-MAR-94

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

FE ; -- editing of facility

 N DA,DIE,DR,DTOUT

 D LMOPT^IBATUTL

 S DA=IBIEN,DIE="^IBAT(351.61,",DR=".11"

 I $P(^IBAT(351.61,DA,0),U,5)="X" W !!,"Transaction cancelled!" D H Q

 L +^IBAT(351.61,IBIEN):0

 I $T D ^DIE L -^IBAT(351.61,IBIEN) D INIT^IBATLM2 Q

 W !?5,"Another user is editing this entry."

 D H,INIT^IBATLM2

 Q

H ; call hang call

 D H^IBATLM1B

 Q

PI ; -- editing of pricing information

 N DA,DIE,DR,DTOUT,ICDVDT,ICPTVDT

 D LMOPT^IBATUTL

 L +^IBAT(351.61,IBIEN):0

 I '$T W !?5,"Another user is editing this entry." D H Q

 S (ICDVDT,ICPTVDT)=$P(IBDATA(0),U,4) ; Code Text Versioning

 S DR=$S($P(IBDATA(0),U,12)["DGPM":"1.01;D DRGDSP^IBATLM2B(X);1.02:1.06",$P(IBDATA(0),"^",12)["SCE":"[IBAT OUT PRICING EDIT]",$P(IBDATA(0),"^",12)["RMPR":"4.05",1:"4.02;4.03")

 S DIE="^IBAT(351.61,",DA=IBIEN

 I $P(^IBAT(351.61,DA,0),U,5)="X" W !!,"Transaction cancelled!" D H Q

 D ^DIE,TOTAL^IBATCM(IBIEN)

 L -^IBAT(351.61,IBIEN)

 D INIT^IBATLM2

 Q

DRGDSP(DRG) ; called from editing pricing info to display DRG pricing

 N IB0,X,Y,IBCHRG Q:'DRG

 S IB0=^IBAT(351.61,DA,0)

 S IBCHRG=$$INPT^IBATCM(DRG,$P(IB0,"^",4),$P(IB0,"^",11))

 S X=$P(IBCHRG,"^",2) D COMMA^%DTC

 W !!,?8,"Default Price $",X,! Q:'$P(IBCHRG,"^",3)

 S X=$P(IBCHRG,"^",3) D COMMA^%DTC

 W ?5,"Negotiated Price $",X,!

 Q

CPTDSP(CPT) ; called from editing pricing info to display CPT pricing

 N IB0,X,Y,IBCHRG Q:'CPT

 S IB0=^IBAT(351.61,DA(1),0)

 S IBCHRG=$$OPT^IBATCM(CPT,$P(IB0,"^",4),$P(IB0,"^",11))

 S X=$P(IBCHRG,"^",2) D COMMA^%DTC

 W !!,?8,"Default Price $",X,! Q:'$P(IBCHRG,"^",3)

 S X=$P(IBCHRG,"^",3) D COMMA^%DTC

 W ?5,"Negotiated Price $",X,!

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBATLM2B   1849     printed  Feb 18, 2025@23:34:19                                                                                                                                                                                                    Page 2

IBATLM2B  ;LL/ELZ - TRANSFER PRICING PT TRANSACTION DETAIL ; 15-SEP-1998

 +1       ;;2.0;INTEGRATED BILLING;**115,266**;21-MAR-94

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

FE        ; -- editing of facility

 +1        NEW DA,DIE,DR,DTOUT

 +2        DO LMOPT^IBATUTL

 +3        SET DA=IBIEN

           SET DIE="^IBAT(351.61,"

           SET DR=".11"

 +4        IF $PIECE(^IBAT(351.61,DA,0),U,5)="X"

               WRITE !!,"Transaction cancelled!"

               DO H

               QUIT 

 +5        LOCK +^IBAT(351.61,IBIEN):0

 +6        IF $TEST

               DO ^DIE

               LOCK -^IBAT(351.61,IBIEN)

               DO INIT^IBATLM2

               QUIT 

 +7        WRITE !?5,"Another user is editing this entry."

 +8        DO H

           DO INIT^IBATLM2

 +9        QUIT 

H         ; call hang call

 +1        DO H^IBATLM1B

 +2        QUIT 

PI        ; -- editing of pricing information

 +1        NEW DA,DIE,DR,DTOUT,ICDVDT,ICPTVDT

 +2        DO LMOPT^IBATUTL

 +3        LOCK +^IBAT(351.61,IBIEN):0

 +4        IF '$TEST

               WRITE !?5,"Another user is editing this entry."

               DO H

               QUIT 

 +5       ; Code Text Versioning

           SET (ICDVDT,ICPTVDT)=$PIECE(IBDATA(0),U,4)

 +6        SET DR=$SELECT($PIECE(IBDATA(0),U,12)["DGPM":"1.01;D DRGDSP^IBATLM2B(X);1.02:1.06",$PIECE(IBDATA(0),"^",12)["SCE":"[IBAT OUT PRICING EDIT]",$PIECE(IBDATA(0),"^",12)["RMPR":"4.05",1:"4.02;4.03")

 +7        SET DIE="^IBAT(351.61,"

           SET DA=IBIEN

 +8        IF $PIECE(^IBAT(351.61,DA,0),U,5)="X"

               WRITE !!,"Transaction cancelled!"

               DO H

               QUIT 

 +9        DO ^DIE

           DO TOTAL^IBATCM(IBIEN)

 +10       LOCK -^IBAT(351.61,IBIEN)

 +11       DO INIT^IBATLM2

 +12       QUIT 

DRGDSP(DRG) ; called from editing pricing info to display DRG pricing

 +1        NEW IB0,X,Y,IBCHRG

           if 'DRG

               QUIT 

 +2        SET IB0=^IBAT(351.61,DA,0)

 +3        SET IBCHRG=$$INPT^IBATCM(DRG,$PIECE(IB0,"^",4),$PIECE(IB0,"^",11))

 +4        SET X=$PIECE(IBCHRG,"^",2)

           DO COMMA^%DTC

 +5        WRITE !!,?8,"Default Price $",X,!

           if '$PIECE(IBCHRG,"^",3)

               QUIT 

 +6        SET X=$PIECE(IBCHRG,"^",3)

           DO COMMA^%DTC

 +7        WRITE ?5,"Negotiated Price $",X,!

 +8        QUIT 

CPTDSP(CPT) ; called from editing pricing info to display CPT pricing

 +1        NEW IB0,X,Y,IBCHRG

           if 'CPT

               QUIT 

 +2        SET IB0=^IBAT(351.61,DA(1),0)

 +3        SET IBCHRG=$$OPT^IBATCM(CPT,$PIECE(IB0,"^",4),$PIECE(IB0,"^",11))

 +4        SET X=$PIECE(IBCHRG,"^",2)

           DO COMMA^%DTC

 +5        WRITE !!,?8,"Default Price $",X,!

           if '$PIECE(IBCHRG,"^",3)

               QUIT 

 +6        SET X=$PIECE(IBCHRG,"^",3)

           DO COMMA^%DTC

 +7        WRITE ?5,"Negotiated Price $",X,!

 +8        QUIT