Routine: BGOVTC

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)

 ; 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")

 ; 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

 ; Delete a V Transaction Code entry

DEL(RET,VFIEN) ;EP

 D VFDEL^BGOUTL2(.RET,$$FNUM,VFIEN)

 ; 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

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))

 ; 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

BGOVTC.m