SDOEPRV.m

SDOEPRV ;ALB/MJK - ACRP Provider APIs For An Encounter ;8/12/96

 ;;5.3;Scheduling;**131,1015**;Aug 13, 1993;Build 21

 ;

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

 ;

SDOEPRV   ;ALB/MJK - ACRP Provider APIs For An Encounter ;8/12/96

 +1       ;;5.3;Scheduling;**131,1015**;Aug 13, 1993;Build 21

 +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      ;