BGOVPRV.m

BGOVPRV ; IHS/BAO/TMD - V PROVIDER file RPCs ;09-Apr-2012 14:54;DU

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

 ; Return primary provider for a visit

PRIPRV(RET,VIEN) ;EP

 S RET=$$PRIPRV^BGOUTL(VIEN)

 Q

 ; Set primary provider

 ;  INP = Visit IEN [1] ^ Patient IEN [2] ^ Provider IEN [3] ^ Primary/Secondary (P/S) [4] ^

 ;        Force Conversion to Primary (Y/N) [5]

SETVPRV(RET,INP) ;

 N X,VIEN,VPRV,DFN,PRV,PRI,FORCE,PRIPRV,IENS,FDA,FNUM

 S RET="",FNUM=$$FNUM

 S VIEN=+INP

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

 S RET=$$CHKVISIT^BGOUTL(VIEN,DFN)

 Q:RET

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

 Q:PRV=0

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

 S:'$L(PRI) PRI="S"

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

 S FORCE=FORCE!(FORCE="Y")

 S PRIPRV=$$PRIPRV^BGOUTL(VIEN)

 I PRIPRV>0,PRI="P",+PRIPRV'=PRV D  Q:RET

 .I FORCE S FDA(FNUM,$P(PRIPRV,U,3)_",",.04)="S"

 .E  S RET=$$ERR^BGOUTL(1098,$P(PRIPRV,U,2))

 S (X,VPRV)=0

 F  S X=$O(^AUPNVPRV("AD",VIEN,X)) Q:'X  D  Q:VPRV

 .S:$P($G(^AUPNVPRV(X,0)),U)=PRV VPRV=X

 S IENS=$S(VPRV:VPRV_",",1:"+1,")

 S FDA=$NA(FDA(FNUM,IENS))

 S @FDA@(.01)=PRV

 S @FDA@(.02)=DFN

 S @FDA@(.03)=VIEN

 S @FDA@(.04)=PRI

 ;Patch 11 Set date entered

 S @FDA@(1216)=$$NOW^XLFDT

 S @FDA@(1217)=DUZ

 ;Patch 11 Set last modified

 S @FDA@(1218)=$$NOW^XLFDT

 S @FDA@(1219)=DUZ

 S RET=$$UPDATE^BGOUTL(.FDA)

 Q

 ; Return V File #

FNUM() Q 9000010.06

BGOVPRV   ; IHS/BAO/TMD - V PROVIDER file RPCs ;09-Apr-2012 14:54;DU

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

 +2       ; Return primary provider for a visit

PRIPRV(RET,VIEN) ;EP

 +1        SET RET=$$PRIPRV^BGOUTL(VIEN)

 +2        QUIT 

 +3       ; Set primary provider

 +4       ;  INP = Visit IEN [1] ^ Patient IEN [2] ^ Provider IEN [3] ^ Primary/Secondary (P/S) [4] ^

 +5       ;        Force Conversion to Primary (Y/N) [5]

SETVPRV(RET,INP) ;

 +1        NEW X,VIEN,VPRV,DFN,PRV,PRI,FORCE,PRIPRV,IENS,FDA,FNUM

 +2        SET RET=""

           SET FNUM=$$FNUM

 +3        SET VIEN=+INP

 +4        SET DFN=$PIECE(INP,U,2)

 +5        SET RET=$$CHKVISIT^BGOUTL(VIEN,DFN)

 +6        IF RET

               QUIT 

 +7        SET PRV=$PIECE(INP,U,3)

 +8        IF PRV=0

               QUIT 

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

 +10       IF '$LENGTH(PRI)

               SET PRI="S"

 +11       SET FORCE=$PIECE(INP,U,5)

 +12       SET FORCE=FORCE!(FORCE="Y")

 +13       SET PRIPRV=$$PRIPRV^BGOUTL(VIEN)

 +14       IF PRIPRV>0

               IF PRI="P"

                   IF +PRIPRV'=PRV

                       Begin DoDot:1

 +15                       IF FORCE

                               SET FDA(FNUM,$PIECE(PRIPRV,U,3)_",",.04)="S"

 +16                      IF '$TEST

                               SET RET=$$ERR^BGOUTL(1098,$PIECE(PRIPRV,U,2))

                       End DoDot:1

                       IF RET

                           QUIT 

 +17       SET (X,VPRV)=0

 +18       FOR 

               SET X=$ORDER(^AUPNVPRV("AD",VIEN,X))

               IF 'X

                   QUIT 

               Begin DoDot:1

 +19               IF $PIECE($GET(^AUPNVPRV(X,0)),U)=PRV

                       SET VPRV=X

               End DoDot:1

               IF VPRV

                   QUIT 

 +20       SET IENS=$SELECT(VPRV:VPRV_",",1:"+1,")

 +21       SET FDA=$NAME(FDA(FNUM,IENS))

 +22       SET @FDA@(.01)=PRV

 +23       SET @FDA@(.02)=DFN

 +24       SET @FDA@(.03)=VIEN

 +25       SET @FDA@(.04)=PRI

 +26      ;Patch 11 Set date entered

 +27       SET @FDA@(1216)=$$NOW^XLFDT

 +28       SET @FDA@(1217)=DUZ

 +29      ;Patch 11 Set last modified

 +30       SET @FDA@(1218)=$$NOW^XLFDT

 +31       SET @FDA@(1219)=DUZ

 +32       SET RET=$$UPDATE^BGOUTL(.FDA)

 +33       QUIT 

 +34      ; Return V File #

FNUM()     QUIT 9000010.06