SDOEPRV ;ALB/MJK - ACRP Provider APIs For An Encounter ;8/12/96
;;5.3;Scheduling;**131**;Aug 13, 1993
;
PRV(SDOE,SDERR) ; -- SDOE ASSIGNED A PROVIDER
; API ID: 63
;
;
N SDOK
S SDOK=0
;
; -- do validation checks
IF '$$VALOE^SDOEOE(.SDOE,$G(SDERR)) G PRVQ
IF $$OLD^SDOEUT(SDOE) S SDOK=$$OLDPRV(SDOE) G PRVQ
;
S SDOK=$$PRV^PXAPIOE($$VIEN^SDOEUT(.SDOE),$G(SDERR))
PRVQ Q SDOK
;
;
GETPRV(SDOE,SDPRV,SDERR) ; -- SDOE GET PROVIDERS
; API ID: 58
;
;
GETPRVG ;; -- goto entry point
; -- do validation checks
IF '$$VALOE^SDOEOE(.SDOE,$G(SDERR)) G GETPRVQ
IF $$OLD^SDOEUT(SDOE) D OLDPRVS(SDOE,.SDPRV) G GETPRVQ
;
D GETPRV^PXAPIOE($$VIEN^SDOEUT(.SDOE),.SDPRV,$G(SDERR))
GETPRVQ Q
;
;
FINDPRV(SDOE,SDPRVID,SDERR) ; -- SDOE FIND PROVIDER
; API ID: 69
;
;
N SDPRVS,SDOK,I
S SDPRVS="SDPRVS"
;
; -- do validation checks
IF '$$VALPRV(.SDPRVID,$G(SDERR)) S SDOK=0 G FINDPRVQ
;
D GETPRV(.SDOE,.SDPRVS,$G(SDERR))
S (I,SDOK)=0
F S I=$O(SDPRVS(I)) Q:'I S SDOK=(+SDPRVS(I)=SDPRVID) Q:SDOK
FINDPRVQ Q SDOK
;
;
VALPRV(SDPRVID,SDERR) ; -- validate provider input
;
; -- do checks
IF SDPRVID,$D(^VA(200,SDPRVID,0)) Q 1
;
; -- build error msg
N SDIN,SDOUT
S SDIN("ID")=SDPRVID
S SDOUT("ID")=SDPRVID
D BLD^SDQVAL(4096800.003,.SDIN,.SDOUT,$G(SDERR))
Q 0
;
;
OLDPRV(SDOE) ; -- at least one provider for OLD encounter?
Q ($O(^SDD(409.44,"OE",+SDOE,0))>0)
;
OLDPRVS(SDOE,SDARY) ; -- get provider's for OLD encounter
N SDIEN,SDCNT,Y,X
S (SDIEN,SDCNT)=0
F S SDIEN=$O(^SDD(409.44,"OE",SDOE,SDIEN)) Q:'SDIEN D
. S SDCNT=SDCNT+1,X=$G(^SDD(409.44,SDIEN,0))
. S $P(Y,U,1)=+X ; -- person ien
. S $P(Y,U,6)=$P(X,"^",3) ; -- person class
. S @SDARY@(SDIEN)=Y
S @SDARY=SDCNT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDOEPRV 1790 printed Apr 09, 2024@21:52:56 Page 2
SDOEPRV ;ALB/MJK - ACRP Provider APIs For An Encounter ;8/12/96
+1 ;;5.3;Scheduling;**131**;Aug 13, 1993
+2 ;
PRV(SDOE,SDERR) ; -- SDOE ASSIGNED A PROVIDER
+1 ; API ID: 63
+2 ;
+3 ;
+4 NEW SDOK
+5 SET SDOK=0
+6 ;
+7 ; -- do validation checks
+8 IF '$$VALOE^SDOEOE(.SDOE,$GET(SDERR))
GOTO PRVQ
+9 IF $$OLD^SDOEUT(SDOE)
SET SDOK=$$OLDPRV(SDOE)
GOTO PRVQ
+10 ;
+11 SET SDOK=$$PRV^PXAPIOE($$VIEN^SDOEUT(.SDOE),$GET(SDERR))
PRVQ QUIT SDOK
+1 ;
+2 ;
GETPRV(SDOE,SDPRV,SDERR) ; -- SDOE GET PROVIDERS
+1 ; API ID: 58
+2 ;
+3 ;
GETPRVG ;; -- goto entry point
+1 ; -- do validation checks
+2 IF '$$VALOE^SDOEOE(.SDOE,$GET(SDERR))
GOTO GETPRVQ
+3 IF $$OLD^SDOEUT(SDOE)
DO OLDPRVS(SDOE,.SDPRV)
GOTO GETPRVQ
+4 ;
+5 DO GETPRV^PXAPIOE($$VIEN^SDOEUT(.SDOE),.SDPRV,$GET(SDERR))
GETPRVQ QUIT
+1 ;
+2 ;
FINDPRV(SDOE,SDPRVID,SDERR) ; -- SDOE FIND PROVIDER
+1 ; API ID: 69
+2 ;
+3 ;
+4 NEW SDPRVS,SDOK,I
+5 SET SDPRVS="SDPRVS"
+6 ;
+7 ; -- do validation checks
+8 IF '$$VALPRV(.SDPRVID,$GET(SDERR))
SET SDOK=0
GOTO FINDPRVQ
+9 ;
+10 DO GETPRV(.SDOE,.SDPRVS,$GET(SDERR))
+11 SET (I,SDOK)=0
+12 FOR
SET I=$ORDER(SDPRVS(I))
if 'I
QUIT
SET SDOK=(+SDPRVS(I)=SDPRVID)
if SDOK
QUIT
FINDPRVQ QUIT SDOK
+1 ;
+2 ;
VALPRV(SDPRVID,SDERR) ; -- validate provider input
+1 ;
+2 ; -- do checks
+3 IF SDPRVID
IF $DATA(^VA(200,SDPRVID,0))
QUIT 1
+4 ;
+5 ; -- build error msg
+6 NEW SDIN,SDOUT
+7 SET SDIN("ID")=SDPRVID
+8 SET SDOUT("ID")=SDPRVID
+9 DO BLD^SDQVAL(4096800.003,.SDIN,.SDOUT,$GET(SDERR))
+10 QUIT 0
+11 ;
+12 ;
OLDPRV(SDOE) ; -- at least one provider for OLD encounter?
+1 QUIT ($ORDER(^SDD(409.44,"OE",+SDOE,0))>0)
+2 ;
OLDPRVS(SDOE,SDARY) ; -- get provider's for OLD encounter
+1 NEW SDIEN,SDCNT,Y,X
+2 SET (SDIEN,SDCNT)=0
+3 FOR
SET SDIEN=$ORDER(^SDD(409.44,"OE",SDOE,SDIEN))
if 'SDIEN
QUIT
Begin DoDot:1
+4 SET SDCNT=SDCNT+1
SET X=$GET(^SDD(409.44,SDIEN,0))
+5 ; -- person ien
SET $PIECE(Y,U,1)=+X
+6 ; -- person class
SET $PIECE(Y,U,6)=$PIECE(X,"^",3)
+7 SET @SDARY@(SDIEN)=Y
End DoDot:1
+8 SET @SDARY=SDCNT
+9 QUIT
+10 ;
