- 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 Feb 19, 2025@00:25:37 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 ;