BGOVTC ; IHS/BAO/TMD - Manage V TRANSACTION CODES ;20-Mar-2007 13:52;DKM
;;1.1;BGO COMPONENTS;**1,3**;Mar 20, 2007
; Get transaction code entry
GETTC(RET,TCIEN) ;EP
N IENS,X
K RET
I '$D(^BCMTCF(TCIEN,0)) S RET(0)=$$ERR^BGOUTL(1100) Q
S IENS=TCIEN_","
D GETS^DIQ(90092.02,IENS,".01;.05;.06;.07;.09;1103","IE","RET")
S IENS=+^BCMTCF(TCIEN,0)_","
D GETS^DIQ(90092.01,IENS,".05;1102;1103;1104","IE","RET")
S X=$G(RET(90092.01,IENS,.05,"I"))
S:X RET(90092.01,IENS,.05,"E")=$P($G(^BCMSCC(X,0)),U,2)
S X=$G(RET(90092.01,IENS,1102,"I"))
S:X RET(90092.01,IENS,1102,"E")=$P($G(^ICPT(X,0)),U,2)
S X=$G(RET(90092.01,IENS,1103,"I"))
S:X RET(90092.01,IENS,1103,"E")=$P($G(^AUTTCMOD(X,0)),U,2)
Q
; Get transaction code info for a single entry or for a visit
; INP = Patient IEN [1] ^ V File IEN [2] ^ Visit IEN [3]
GET(RET,INP) ;EP
D VFGET^BGOUTL2(.RET,INP,$$FNUM,".01;.02;.03;.04;.05;.06;.07;.09;.11;.12;.13;1201;1204")
Q
; Add/edit V Transaction Code
; INP = V File IEN [1] ^ TC IEN [2] ^ Visit IEN [3] ^ Patient IEN [4] ^ No dups [5]
SET(RET,INP) ;EP
N VIEN,VFIEN,VFNEW,TYPE,DFN,DUPS,TCA,MOD,FDA,FNUM,SVRCLS,CAN,NARR,DEPT
N CHRG,MODCODE,REVCD,X,Y
S RET="",FNUM=$$FNUM
S VFIEN=+INP
S VFNEW='VFIEN
S TYPE=+$P(INP,U,2)
S VIEN=+$P(INP,U,3)
S DFN=+$P(INP,U,4)
S DUPS='$P(INP,U,5)
S RET=$$CHKVISIT^BGOUTL(VIEN,DFN)
Q:RET
I 'TYPE S RET=$$ERR^BGOUTL(1099) Q
S X=$G(^BCMTCF(TYPE,0)),Y=$G(^(11))
I '$L(X) S RET=$$ERR^BGOUTL(1100) Q
I $P(X,U,4) S RET=$$ERR^BGOUTL(1101) Q
S TCA=$P(X,U),CAN=$P(X,U,5),SVRCLS=$P(X,U,6),NARR=$P(X,U,7),DEPT=$P(X,U,9),CHRG=$P(Y,U,3)
S X=$G(^BCMTCA(TCA,0)),Y=$G(^(11))
S SVRCLS=$P(X,U,5),CPT=$P(Y,U,2),MODCODE=$P(Y,U,3),REVCD=$P(Y,U,4)
S MOD=$S($L(MODCODE):$O(^AUTTCMOD("B",MODCODE,0)),1:"")
I 'VFIEN D Q:'VFIEN
.D VFNEW^BGOUTL2(.RET,FNUM,TYPE,VIEN,$S('DUPS:"Transaction code",1:""))
.S:RET>0 VFIEN=RET,RET=""
S FDA=$NA(FDA(FNUM,VFIEN_","))
S @FDA@(.01)="`"_TYPE
S @FDA@(.04)=$S(CAN:"`"_CAN,1:"")
S @FDA@(.05)=$S(SVRCLS:"`"_SVRCLS,1:"")
S @FDA@(.06)=CHRG
S @FDA@(.08)=MODCODE
S @FDA@(.11)=NARR
S @FDA@(.12)=$S(MOD:"`"_MOD,1:"")
S @FDA@(.13)=$S(DEPT:"`"_DEPT,1:"")
S @FDA@(1201)="N"
S @FDA@(1204)="`"_DUZ
S RET=$$UPDATE^BGOUTL(.FDA,"E")
I RET,VFNEW,$$DELETE^BGOUTL(FNUM,VFIEN)
D:'RET VFEVT^BGOUTL2(FNUM,VFIEN,'VFNEW)
S:'RET RET=VFIEN
Q
; Delete a V Transaction Code entry
DEL(RET,VFIEN) ;EP
D VFDEL^BGOUTL2(.RET,$$FNUM,VFIEN)
Q
; Retrieve CM list
CMLKUP(RET,INP) ;EP
N IEN,FLD,CNT,TRNCODE,CPT
S RET=$$TMPGBL^BGOUTL
S TRNCODE=$P(INP,U,2),CPT=""
S:TRNCODE?5.6N CPT=TRNCODE,TRNCODE=""
I TRNCODE'?8N,TRNCODE'="" D Q
.D FIND^DIC(90092.02,,"@;.01;.07;.05;.06","P",TRNCODE,"","","","",RET)
.K @RET@("DILIST",0)
S CNT=0
I TRNCODE D
.S IEN=0
.F S IEN=$O(^BCMTCF("B",TRNCODE,IEN)) Q:'IEN D CM1
E I CPT D
.S TRNCODE=0
.F S TRNCODE=$O(^BCMTCA("C",CPT,TRNCODE)) Q:'TRNCODE D
..S IEN=0
..F S IEN=$O(^BCMTCF("B",TRNCODE,IEN)) Q:'IEN D CM1
E D
.S IEN=0
.F S IEN=$O(^BCMTCF(IEN)) Q:'IEN D CM1
Q
CM1 N X
S X=$G(^BCMTCF(IEN,0))
Q:'$L(X)
Q:$P(X,U,4)
S CNT=CNT+1,@RET@(CNT)=IEN_U_$P(X,U)_U_$P(X,U,7)_U_$$EXTERNAL^DILFD(90092.02,.05,,$P(X,U,5))_U_$$EXTERNAL^DILFD(90092.02,.06,,$P(X,U,6))
Q
; Return V File #
FNUM() Q 9000010.33
BGOVTC ; IHS/BAO/TMD - Manage V TRANSACTION CODES ;20-Mar-2007 13:52;DKM
+1 ;;1.1;BGO COMPONENTS;**1,3**;Mar 20, 2007
+2 ; Get transaction code entry
GETTC(RET,TCIEN) ;EP
+1 NEW IENS,X
+2 KILL RET
+3 IF '$DATA(^BCMTCF(TCIEN,0))
SET RET(0)=$$ERR^BGOUTL(1100)
QUIT
+4 SET IENS=TCIEN_","
+5 DO GETS^DIQ(90092.02,IENS,".01;.05;.06;.07;.09;1103","IE","RET")
+6 SET IENS=+^BCMTCF(TCIEN,0)_","
+7 DO GETS^DIQ(90092.01,IENS,".05;1102;1103;1104","IE","RET")
+8 SET X=$GET(RET(90092.01,IENS,.05,"I"))
+9 IF X
SET RET(90092.01,IENS,.05,"E")=$PIECE($GET(^BCMSCC(X,0)),U,2)
+10 SET X=$GET(RET(90092.01,IENS,1102,"I"))
+11 IF X
SET RET(90092.01,IENS,1102,"E")=$PIECE($GET(^ICPT(X,0)),U,2)
+12 SET X=$GET(RET(90092.01,IENS,1103,"I"))
+13 IF X
SET RET(90092.01,IENS,1103,"E")=$PIECE($GET(^AUTTCMOD(X,0)),U,2)
+14 QUIT
+15 ; Get transaction code info for a single entry or for a visit
+16 ; INP = Patient IEN [1] ^ V File IEN [2] ^ Visit IEN [3]
GET(RET,INP) ;EP
+1 DO VFGET^BGOUTL2(.RET,INP,$$FNUM,".01;.02;.03;.04;.05;.06;.07;.09;.11;.12;.13;1201;1204")
+2 QUIT
+3 ; Add/edit V Transaction Code
+4 ; INP = V File IEN [1] ^ TC IEN [2] ^ Visit IEN [3] ^ Patient IEN [4] ^ No dups [5]
SET(RET,INP) ;EP
+1 NEW VIEN,VFIEN,VFNEW,TYPE,DFN,DUPS,TCA,MOD,FDA,FNUM,SVRCLS,CAN,NARR,DEPT
+2 NEW CHRG,MODCODE,REVCD,X,Y
+3 SET RET=""
SET FNUM=$$FNUM
+4 SET VFIEN=+INP
+5 SET VFNEW='VFIEN
+6 SET TYPE=+$PIECE(INP,U,2)
+7 SET VIEN=+$PIECE(INP,U,3)
+8 SET DFN=+$PIECE(INP,U,4)
+9 SET DUPS='$PIECE(INP,U,5)
+10 SET RET=$$CHKVISIT^BGOUTL(VIEN,DFN)
+11 IF RET
QUIT
+12 IF 'TYPE
SET RET=$$ERR^BGOUTL(1099)
QUIT
+13 SET X=$GET(^BCMTCF(TYPE,0))
SET Y=$GET(^(11))
+14 IF '$LENGTH(X)
SET RET=$$ERR^BGOUTL(1100)
QUIT
+15 IF $PIECE(X,U,4)
SET RET=$$ERR^BGOUTL(1101)
QUIT
+16 SET TCA=$PIECE(X,U)
SET CAN=$PIECE(X,U,5)
SET SVRCLS=$PIECE(X,U,6)
SET NARR=$PIECE(X,U,7)
SET DEPT=$PIECE(X,U,9)
SET CHRG=$PIECE(Y,U,3)
+17 SET X=$GET(^BCMTCA(TCA,0))
SET Y=$GET(^(11))
+18 SET SVRCLS=$PIECE(X,U,5)
SET CPT=$PIECE(Y,U,2)
SET MODCODE=$PIECE(Y,U,3)
SET REVCD=$PIECE(Y,U,4)
+19 SET MOD=$SELECT($LENGTH(MODCODE):$ORDER(^AUTTCMOD("B",MODCODE,0)),1:"")
+20 IF 'VFIEN
Begin DoDot:1
+21 DO VFNEW^BGOUTL2(.RET,FNUM,TYPE,VIEN,$SELECT('DUPS:"Transaction code",1:""))
+22 IF RET>0
SET VFIEN=RET
SET RET=""
End DoDot:1
IF 'VFIEN
QUIT
+23 SET FDA=$NAME(FDA(FNUM,VFIEN_","))
+24 SET @FDA@(.01)="`"_TYPE
+25 SET @FDA@(.04)=$SELECT(CAN:"`"_CAN,1:"")
+26 SET @FDA@(.05)=$SELECT(SVRCLS:"`"_SVRCLS,1:"")
+27 SET @FDA@(.06)=CHRG
+28 SET @FDA@(.08)=MODCODE
+29 SET @FDA@(.11)=NARR
+30 SET @FDA@(.12)=$SELECT(MOD:"`"_MOD,1:"")
+31 SET @FDA@(.13)=$SELECT(DEPT:"`"_DEPT,1:"")
+32 SET @FDA@(1201)="N"
+33 SET @FDA@(1204)="`"_DUZ
+34 SET RET=$$UPDATE^BGOUTL(.FDA,"E")
+35 IF RET
IF VFNEW
IF $$DELETE^BGOUTL(FNUM,VFIEN)
+36 IF 'RET
DO VFEVT^BGOUTL2(FNUM,VFIEN,'VFNEW)
+37 IF 'RET
SET RET=VFIEN
+38 QUIT
+39 ; Delete a V Transaction Code entry
DEL(RET,VFIEN) ;EP
+1 DO VFDEL^BGOUTL2(.RET,$$FNUM,VFIEN)
+2 QUIT
+3 ; Retrieve CM list
CMLKUP(RET,INP) ;EP
+1 NEW IEN,FLD,CNT,TRNCODE,CPT
+2 SET RET=$$TMPGBL^BGOUTL
+3 SET TRNCODE=$PIECE(INP,U,2)
SET CPT=""
+4 IF TRNCODE?5.6N
SET CPT=TRNCODE
SET TRNCODE=""
+5 IF TRNCODE'?8N
IF TRNCODE'=""
Begin DoDot:1
+6 DO FIND^DIC(90092.02,,"@;.01;.07;.05;.06","P",TRNCODE,"","","","",RET)
+7 KILL @RET@("DILIST",0)
End DoDot:1
QUIT
+8 SET CNT=0
+9 IF TRNCODE
Begin DoDot:1
+10 SET IEN=0
+11 FOR
SET IEN=$ORDER(^BCMTCF("B",TRNCODE,IEN))
IF 'IEN
QUIT
DO CM1
End DoDot:1
+12 IF '$TEST
IF CPT
Begin DoDot:1
+13 SET TRNCODE=0
+14 FOR
SET TRNCODE=$ORDER(^BCMTCA("C",CPT,TRNCODE))
IF 'TRNCODE
QUIT
Begin DoDot:2
+15 SET IEN=0
+16 FOR
SET IEN=$ORDER(^BCMTCF("B",TRNCODE,IEN))
IF 'IEN
QUIT
DO CM1
End DoDot:2
End DoDot:1
+17 IF '$TEST
Begin DoDot:1
+18 SET IEN=0
+19 FOR
SET IEN=$ORDER(^BCMTCF(IEN))
IF 'IEN
QUIT
DO CM1
End DoDot:1
+20 QUIT
CM1 NEW X
+1 SET X=$GET(^BCMTCF(IEN,0))
+2 IF '$LENGTH(X)
QUIT
+3 IF $PIECE(X,U,4)
QUIT
+4 SET CNT=CNT+1
SET @RET@(CNT)=IEN_U_$PIECE(X,U)_U_$PIECE(X,U,7)_U_$$EXTERNAL^DILFD(90092.02,.05,,$PIECE(X,U,5))_U_$$EXTERNAL^DILFD(90092.02,.06,,$PIECE(X,U,6))
+5 QUIT
+6 ; Return V File #
FNUM() QUIT 9000010.33
