BSDX44 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
; 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)
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
S RET=$$UPDATE^BGOUTL(.FDA)
Q
; Return V File #
FNUM() Q 9000010.06
;
;return data from the V PROVIDER file
GETPRV(BGOY,VPRV) ;
; .BGOY = returned pointer to list of V PROVIDER data
; VPRV = V PROVIDER code - pointer to ^AUPNVPRV
; called by BSDX GETVPRV
N BGOI,BGONOD,BGOVP
D ^XBKVAR S X="ERROR^BSDX25",@^%ZOSF("TRAP")
S BGOI=0
K ^BGOTMP($J)
S BGOY="^BGOTMP("_$J_")"
S ^BGOTMP($J,0)="T00020ERRORID"_$C(30)
;check for valid V PROVIDER
I '+VPRV D ERR("BGOPRV: Invalid V Provider ID") Q
I '$D(^AUPNVPRV(VPRV,0)) D ERR("BGOPRV: Invalid V Provider ID") Q
S BGONOD=^AUPNVPRV(VPRV,0)
; 1 2 3 4 5
S ^BGOTMP($J,0)="I00020V_PROVIDER_IEN^I00020PROVIDER_IEN^I00020PATIENT_NAME^T00030VISIT^T00030PROVIDER_STATUS"_$C(30)
S BGOVP=VPRV_U ; V_PROVIDER_IEN
S BGOVP=BGOVP_$P(BGONOD,U,1)_U ; PROVIDER_IEN
S BGOVP=BGOVP_$P(BGONOD,U,2)_U ; PATIENT_NAME
S BGOVP=BGOVP_$P(BGONOD,U,3)_U ; VISIT
S BGOVP=BGOVP_$P(BGONOD,U,5) ; PROVIDER_STATUS
S BGOI=BGOI+1
S ^BGOTMP($J,BGOI)=BGOVP
S BGOI=BGOI+1
S ^BGOTMP($J,BGOI)=$C(30)
S BGOI=BGOI+1
S ^BGOTMP($J,BGOI)=$C(31)
Q
;
ERROR ;
D ERR("RPMS Error")
Q
;
ERR(ERRNO) ;Error processing
I +ERRNO S BGOERR=ERRNO+134234112 ;vbObjectError
E S BGOERR=ERRNO
S BGOI=BGOI+1
S ^BGOTMP($J,BGOI)=BGOERR_$C(30)
S BGOI=BGOI+1
S ^BGOTMP($J,BGOI)=$C(31)
Q
BSDX44 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
+1 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
+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 SET PRI=$PIECE(INP,U,4)
+9 IF '$LENGTH(PRI)
SET PRI="S"
+10 SET FORCE=$PIECE(INP,U,5)
+11 SET FORCE=FORCE!(FORCE="Y")
+12 SET PRIPRV=$$PRIPRV^BGOUTL(VIEN)
+13 IF PRIPRV>0
IF PRI="P"
IF +PRIPRV'=PRV
Begin DoDot:1
+14 IF FORCE
SET FDA(FNUM,$PIECE(PRIPRV,U,3)_",",.04)="S"
+15 IF '$TEST
SET RET=$$ERR^BGOUTL(1098,$PIECE(PRIPRV,U,2))
End DoDot:1
IF RET
QUIT
+16 SET (X,VPRV)=0
+17 FOR
SET X=$ORDER(^AUPNVPRV("AD",VIEN,X))
IF 'X
QUIT
Begin DoDot:1
+18 IF $PIECE($GET(^AUPNVPRV(X,0)),U)=PRV
SET VPRV=X
End DoDot:1
IF VPRV
QUIT
+19 SET IENS=$SELECT(VPRV:VPRV_",",1:"+1,")
+20 SET FDA=$NAME(FDA(FNUM,IENS))
+21 SET @FDA@(.01)=PRV
+22 SET @FDA@(.02)=DFN
+23 SET @FDA@(.03)=VIEN
+24 SET @FDA@(.04)=PRI
+25 SET RET=$$UPDATE^BGOUTL(.FDA)
+26 QUIT
+27 ; Return V File #
FNUM() QUIT 9000010.06
+1 ;
+2 ;return data from the V PROVIDER file
GETPRV(BGOY,VPRV) ;
+1 ; .BGOY = returned pointer to list of V PROVIDER data
+2 ; VPRV = V PROVIDER code - pointer to ^AUPNVPRV
+3 ; called by BSDX GETVPRV
+4 NEW BGOI,BGONOD,BGOVP
+5 DO ^XBKVAR
SET X="ERROR^BSDX25"
SET @^%ZOSF("TRAP")
+6 SET BGOI=0
+7 KILL ^BGOTMP($JOB)
+8 SET BGOY="^BGOTMP("_$JOB_")"
+9 SET ^BGOTMP($JOB,0)="T00020ERRORID"_$CHAR(30)
+10 ;check for valid V PROVIDER
+11 IF '+VPRV
DO ERR("BGOPRV: Invalid V Provider ID")
QUIT
+12 IF '$DATA(^AUPNVPRV(VPRV,0))
DO ERR("BGOPRV: Invalid V Provider ID")
QUIT
+13 SET BGONOD=^AUPNVPRV(VPRV,0)
+14 ; 1 2 3 4 5
+15 SET ^BGOTMP($JOB,0)="I00020V_PROVIDER_IEN^I00020PROVIDER_IEN^I00020PATIENT_NAME^T00030VISIT^T00030PROVIDER_STATUS"_$CHAR(30)
+16 ; V_PROVIDER_IEN
SET BGOVP=VPRV_U
+17 ; PROVIDER_IEN
SET BGOVP=BGOVP_$PIECE(BGONOD,U,1)_U
+18 ; PATIENT_NAME
SET BGOVP=BGOVP_$PIECE(BGONOD,U,2)_U
+19 ; VISIT
SET BGOVP=BGOVP_$PIECE(BGONOD,U,3)_U
+20 ; PROVIDER_STATUS
SET BGOVP=BGOVP_$PIECE(BGONOD,U,5)
+21 SET BGOI=BGOI+1
+22 SET ^BGOTMP($JOB,BGOI)=BGOVP
+23 SET BGOI=BGOI+1
+24 SET ^BGOTMP($JOB,BGOI)=$CHAR(30)
+25 SET BGOI=BGOI+1
+26 SET ^BGOTMP($JOB,BGOI)=$CHAR(31)
+27 QUIT
+28 ;
ERROR ;
+1 DO ERR("RPMS Error")
+2 QUIT
+3 ;
ERR(ERRNO) ;Error processing
+1 ;vbObjectError
IF +ERRNO
SET BGOERR=ERRNO+134234112
+2 IF '$TEST
SET BGOERR=ERRNO
+3 SET BGOI=BGOI+1
+4 SET ^BGOTMP($JOB,BGOI)=BGOERR_$CHAR(30)
+5 SET BGOI=BGOI+1
+6 SET ^BGOTMP($JOB,BGOI)=$CHAR(31)
+7 QUIT
