SDEC44.m

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 ---SDEC44   2761     printed  Feb 19, 2025@00:17:01                                                                                                                                                                                                      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