- 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
