SDEC44 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
;
Q
;
; Get primary provider for a visit
; VIEN = Visit IEN
; Returns Provider IEN ^ Provider Name ^ V Provider IEN
PRIPRV(VIEN) ;EP
N X,Y,RET
Q:'VIEN $$ERR("Invalid visit IEN.")
S X=0,RET=""
F S X=$O(^AUPNVPRV("AD",VIEN,X)) Q:'X D Q:RET>0
.S Y=$G(^AUPNVPRV(X,0))
.S:$P(Y,U,4)="P" RET=$P(Y,U)_U_$P($G(^VA(200,+Y,0)),U)_U_X
Q RET
;
; 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^SDECUTL(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(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("SDEC44",$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^SDECUTL(.FDA)
Q
; Return V File #
FNUM() Q 9000010.06
;
GETVPRV(BGOY,VPRV) ;return data from the V PROVIDER file
;GETVPRV(BGOY,VPRV) external parameter tag is in SDEC
; .BGOY = returned pointer to list of V PROVIDER data
; VPRV = V PROVIDER code - pointer to ^AUPNVPRV
; called by SDEC GETVPRV
N BGOI,BGONOD,BGOVP
S BGOI=0
K ^TMP("SDEC",$J)
S BGOY="^TMP(""SDEC""_$J_"")"""
S ^TMP("SDEC",$J,0)="T00020ERRORID"_$C(30)
;check for valid V PROVIDER
I '+VPRV D ERR("SDEC44: Invalid V Provider ID") Q
I '$D(^AUPNVPRV(VPRV,0)) D ERR("SDEC44: Invalid V Provider ID") Q
S BGONOD=^AUPNVPRV(VPRV,0)
; 1 2 3 4 5
S ^TMP("SDEC",$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 ^TMP("SDEC",$J,BGOI)=BGOVP
S BGOI=BGOI+1
S ^TMP("SDEC",$J,BGOI)=$C(30)
S BGOI=BGOI+1
S ^TMP("SDEC",$J,BGOI)=$C(31)
Q
;
ERROR ;
D ERR("Error")
Q
;
ERR(ERRNO) ;Error processing
S BGOI=$G(BGOI)+1
S ^TMP("SDEC",$J,BGOI)=ERRNO_$C(30)
S BGOI=BGOI+1
S ^TMP("SDEC",$J,BGOI)=$C(31)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC44 2761 printed Apr 09, 2024@21:46:18 Page 2
SDEC44 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
+1 ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
+2 ;
+3 QUIT
+4 ;
+5 ; Get primary provider for a visit
+6 ; VIEN = Visit IEN
+7 ; Returns Provider IEN ^ Provider Name ^ V Provider IEN
PRIPRV(VIEN) ;EP
+1 NEW X,Y,RET
+2 if 'VIEN
QUIT $$ERR("Invalid visit IEN.")
+3 SET X=0
SET RET=""
+4 FOR
SET X=$ORDER(^AUPNVPRV("AD",VIEN,X))
if 'X
QUIT
Begin DoDot:1
+5 SET Y=$GET(^AUPNVPRV(X,0))
+6 if $PIECE(Y,U,4)="P"
SET RET=$PIECE(Y,U)_U_$PIECE($GET(^VA(200,+Y,0)),U)_U_X
End DoDot:1
if RET>0
QUIT
+7 QUIT RET
+8 ;
+9 ; Set primary provider
+10 ; INP = Visit IEN [1] ^ Patient IEN [2] ^ Provider IEN [3] ^ Primary/Secondary (P/S) [4] ^
+11 ; 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^SDECUTL(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(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("SDEC44",$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^SDECUTL(.FDA)
+26 QUIT
+27 ; Return V File #
FNUM() QUIT 9000010.06
+1 ;
GETVPRV(BGOY,VPRV) ;return data from the V PROVIDER file
+1 ;GETVPRV(BGOY,VPRV) external parameter tag is in SDEC
+2 ; .BGOY = returned pointer to list of V PROVIDER data
+3 ; VPRV = V PROVIDER code - pointer to ^AUPNVPRV
+4 ; called by SDEC GETVPRV
+5 NEW BGOI,BGONOD,BGOVP
+6 SET BGOI=0
+7 KILL ^TMP("SDEC",$JOB)
+8 SET BGOY="^TMP(""SDEC""_$J_"")"""
+9 SET ^TMP("SDEC",$JOB,0)="T00020ERRORID"_$CHAR(30)
+10 ;check for valid V PROVIDER
+11 IF '+VPRV
DO ERR("SDEC44: Invalid V Provider ID")
QUIT
+12 IF '$DATA(^AUPNVPRV(VPRV,0))
DO ERR("SDEC44: Invalid V Provider ID")
QUIT
+13 SET BGONOD=^AUPNVPRV(VPRV,0)
+14 ; 1 2 3 4 5
+15 SET ^TMP("SDEC",$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 ^TMP("SDEC",$JOB,BGOI)=BGOVP
+23 SET BGOI=BGOI+1
+24 SET ^TMP("SDEC",$JOB,BGOI)=$CHAR(30)
+25 SET BGOI=BGOI+1
+26 SET ^TMP("SDEC",$JOB,BGOI)=$CHAR(31)
+27 QUIT
+28 ;
ERROR ;
+1 DO ERR("Error")
+2 QUIT
+3 ;
ERR(ERRNO) ;Error processing
+1 SET BGOI=$GET(BGOI)+1
+2 SET ^TMP("SDEC",$JOB,BGOI)=ERRNO_$CHAR(30)
+3 SET BGOI=BGOI+1
+4 SET ^TMP("SDEC",$JOB,BGOI)=$CHAR(31)
+5 QUIT
