BGOVTXC.m

BGOVTXC ; IHS/BAO/TMD - Manage V TREATMENT CONTRACT ;09-Apr-2012 14:19;DU

 ;;1.1;BGO COMPONENTS;**1,3,11**;Mar 20, 2007;Build 3

 ; Return treatment contract entries by individual entry, visit, or patient

 ;  INP = Patient IEN [1] ^ V File IEN [2] ^ Visit IEN [3]

GET(RET,INP) ;EP

 D VFGET^BGOUTL2(.RET,INP,$$FNUM,".03;.01;.04;.05;1201;1204")

 Q

 ; Add/edit V Treatment Contract entry

 ;  INP = V File IEN [1] ^ Visit IEN [2] ^ Type [3] ^ Date [4] ^ Provider IEN [5]

SET(RET,INP) ;EP

 N VIEN,VFIEN,VFNEW,TYPE,DAT,PRV,FDA,FNUM

 S FNUM=$$FNUM

 S VFIEN=+INP

 S VFNEW='VFIEN

 S VIEN=$P(INP,U,2)

 S RET=$$CHKVISIT^BGOUTL(VIEN)

 Q:RET

 S TYPE=$P(INP,U,3)

 S DAT=$P(INP,U,4)

 S PRV=$P(INP,U,5)

 I 'VFIEN D  Q:'VFIEN

 .D VFNEW^BGOUTL2(.RET,FNUM,TYPE,VIEN)

 .S:RET>0 VFIEN=RET,RET=""

 S FDA=$NA(FDA(FNUM,VFIEN_","))

 S @FDA@(.01)=TYPE

 S @FDA@(.04)=DAT

 S @FDA@(.05)=$S(PRV:"`"_PRV,1:"")

 S @FDA@(1201)="N"

 S @FDA@(1204)="`"_DUZ

 ;Patch 11 Set date entered

 I VFNEW D

 .S @FDA@(1216)="N"

 .S @FDA@(1217)="`"_DUZ

 ;Patch 11 Set last modified

 S @FDA@(1218)="N"

 S @FDA@(1219)="`"_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 V Treatment Contract entry

DEL(RET,VFIEN) ;EP

 S RET=""

 Q:'$D(^AUPNVTXC(VFIEN))

 I $P($G(^AUPNVTXC(VFIEN,12)),U,4)'=DUZ,+$$PRIPRV^BGOUTL(VIEN)'=DUZ D  Q

 .S RET=$$ERR^BGOUTL(1106)

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

 Q

 ; Return V File #

FNUM() Q 9000010.39

BGOVTXC   ; IHS/BAO/TMD - Manage V TREATMENT CONTRACT ;09-Apr-2012 14:19;DU

 +1       ;;1.1;BGO COMPONENTS;**1,3,11**;Mar 20, 2007;Build 3

 +2       ; Return treatment contract entries by individual entry, visit, or patient

 +3       ;  INP = Patient IEN [1] ^ V File IEN [2] ^ Visit IEN [3]

GET(RET,INP) ;EP

 +1        DO VFGET^BGOUTL2(.RET,INP,$$FNUM,".03;.01;.04;.05;1201;1204")

 +2        QUIT 

 +3       ; Add/edit V Treatment Contract entry

 +4       ;  INP = V File IEN [1] ^ Visit IEN [2] ^ Type [3] ^ Date [4] ^ Provider IEN [5]

SET(RET,INP) ;EP

 +1        NEW VIEN,VFIEN,VFNEW,TYPE,DAT,PRV,FDA,FNUM

 +2        SET FNUM=$$FNUM

 +3        SET VFIEN=+INP

 +4        SET VFNEW='VFIEN

 +5        SET VIEN=$PIECE(INP,U,2)

 +6        SET RET=$$CHKVISIT^BGOUTL(VIEN)

 +7        IF RET

               QUIT 

 +8        SET TYPE=$PIECE(INP,U,3)

 +9        SET DAT=$PIECE(INP,U,4)

 +10       SET PRV=$PIECE(INP,U,5)

 +11       IF 'VFIEN

               Begin DoDot:1

 +12               DO VFNEW^BGOUTL2(.RET,FNUM,TYPE,VIEN)

 +13               IF RET>0

                       SET VFIEN=RET

                       SET RET=""

               End DoDot:1

               IF 'VFIEN

                   QUIT 

 +14       SET FDA=$NAME(FDA(FNUM,VFIEN_","))

 +15       SET @FDA@(.01)=TYPE

 +16       SET @FDA@(.04)=DAT

 +17       SET @FDA@(.05)=$SELECT(PRV:"`"_PRV,1:"")

 +18       SET @FDA@(1201)="N"

 +19       SET @FDA@(1204)="`"_DUZ

 +20      ;Patch 11 Set date entered

 +21       IF VFNEW

               Begin DoDot:1

 +22               SET @FDA@(1216)="N"

 +23               SET @FDA@(1217)="`"_DUZ

               End DoDot:1

 +24      ;Patch 11 Set last modified

 +25       SET @FDA@(1218)="N"

 +26       SET @FDA@(1219)="`"_DUZ

 +27       SET RET=$$UPDATE^BGOUTL(.FDA,"E")

 +28       IF RET

               IF VFNEW

                   IF $$DELETE^BGOUTL(FNUM,VFIEN)

 +29       IF 'RET

               DO VFEVT^BGOUTL2(FNUM,VFIEN,'VFNEW)

 +30       IF 'RET

               SET RET=VFIEN

 +31       QUIT 

 +32      ; Delete V Treatment Contract entry

DEL(RET,VFIEN) ;EP

 +1        SET RET=""

 +2        IF '$DATA(^AUPNVTXC(VFIEN))

               QUIT 

 +3        IF $PIECE($GET(^AUPNVTXC(VFIEN,12)),U,4)'=DUZ

               IF +$$PRIPRV^BGOUTL(VIEN)'=DUZ

                   Begin DoDot:1

 +4                    SET RET=$$ERR^BGOUTL(1106)

                   End DoDot:1

                   QUIT 

 +5        DO VFDEL^BGOUTL2(.RET,$$FNUM,VFIEN)

 +6        QUIT 

 +7       ; Return V File #

FNUM()     QUIT 9000010.39