SDCO3.m

SDCO3 ;ALB/RMO - Provider - Check Out;08 DEC 1992 4:05 pm

 ;;5.3;Scheduling;**28,27,44,67,71,132,466,1015**;08/13/93;Build 21

 ;

EN ;Entry point for SDCO PROVIDER protocol

 ; Input  -- SDOE

 ;

 S VALMBCK=""

 ;

 ; -- if OLD encounter, quit

 IF '$$EDITOK($G(SDOE),1) G ENQ

 ;

 ; -- call PCE interview

 N SDVISIT,SDHL

 S SDVISIT=$P($G(^SCE(+SDOE,0)),U,5)

 S X=$$INTV^PXAPI("PRV","SD","PIMS",SDVISIT)

 D BLD^SDCO S VALMBCK="R"

ENQ Q

 ;

PRASK(SDOE) ;Ask Provider on Check Out

 ; Input  -- SDOE      Outpatient Encounter IEN

 ; Output -- 0=No, 1=Yes/Required, 2=Yes/Not Required

 N SDCL,SDOE0,SDORG,Y

 S SDOE0=$G(^SCE(+SDOE,0)),SDCL=+$P(SDOE0,"^",4),SDORG=+$P(SDOE0,"^",8)

 I $$REQ^SDM1A(+SDOE0)'="CO" G PRASKQ

 I SDORG=1,'$$CLINIC^SDAMU(SDCL) G PRASKQ

 ;I "^1^2^"[("^"_SDORG_"^"),$$INP^SDAM2(+$P(SDOE0,"^",2),+SDOE0)="I" G PRASKQ  ;SD*5.3*466 allow provider check for inpatients 

 I +SDOE0<2961001 S Y=2 G PRASKQ

 I SDCL S Y=1 G PRASKQ

 I SDORG=3 S Y=1

PRASKQ Q +$G(Y)

 ;

SET(SDOE) ;Set-up Provider Array for Outpatient Encounter

 ; Input  -- SDOE      Outpatient Encounter IEN

 ; Output -- SDPRY     Provider Array Subscripted by a Number

 ;           SDCNT     Number of Array Entries

 N SDVA200,SDVPRV,SDPRVS

 K SDPRY

 D GETPRV^SDOE(SDOE,"SDPRVS")

 S (SDCNT,SDVPRV)=0

 F  S SDVPRV=$O(SDPRVS(SDVPRV)) Q:'SDVPRV  D

 . S SDVA200=+$G(SDPRVS(SDVPRV))

 . S SDCNT=SDCNT+1

 . S SDPRY(SDCNT)=SDVPRV_"^"_SDVA200

SETQ Q

 ;

LIST(SDPRY) ;List Provider Array

 ; Input  -- SDPRY     Provider Array Subscripted by a Number

 ; Output -- List Provider Array

 N I

 W !

 S I=0 F  S I=$O(SDPRY(I)) Q:'I  W !?2,I,"  ",$$PR^SDCO31(+$P(SDPRY(I),"^",2))

 Q

 ;

EDITOK(SDOE,SDMODE) ; -- ok to edit?

 ; input:  SDOE   := ien of 409.68                  [required]

 ;         SDMODE := 1 -- interactive ; 0 -- silent [required]

 ;

 ; returned:  1 -- yes, it's ok to edit or delete SDOE entry

 ;            0 -- no, cannot not change SDOE entry

 ;

 N DIR,SDOK

 S SDOK=$$NEW^SDPCE($P($G(^SCE(+$G(SDOE),0)),U))

 IF 'SDOK,SDMODE D OLDMSG

EDITOKQ Q SDOK

 ;

OLDMSG ; -- display message to user

 W !!,">>> Editing and deleting old encounters not allowed.",!

 N DIR

 S DIR(0)="E"

 S DIR("A")="Press Return key to continue"

 D ^DIR

 Q

 ;

SDCO3     ;ALB/RMO - Provider - Check Out;08 DEC 1992 4:05 pm

 +1       ;;5.3;Scheduling;**28,27,44,67,71,132,466,1015**;08/13/93;Build 21

 +2       ;

EN        ;Entry point for SDCO PROVIDER protocol

 +1       ; Input  -- SDOE

 +2       ;

 +3        SET VALMBCK=""

 +4       ;

 +5       ; -- if OLD encounter, quit

 +6        IF '$$EDITOK($GET(SDOE),1)

               GOTO ENQ

 +7       ;

 +8       ; -- call PCE interview

 +9        NEW SDVISIT,SDHL

 +10       SET SDVISIT=$PIECE($GET(^SCE(+SDOE,0)),U,5)

 +11       SET X=$$INTV^PXAPI("PRV","SD","PIMS",SDVISIT)

 +12       DO BLD^SDCO

           SET VALMBCK="R"

ENQ        QUIT 

 +1       ;

PRASK(SDOE) ;Ask Provider on Check Out

 +1       ; Input  -- SDOE      Outpatient Encounter IEN

 +2       ; Output -- 0=No, 1=Yes/Required, 2=Yes/Not Required

 +3        NEW SDCL,SDOE0,SDORG,Y

 +4        SET SDOE0=$GET(^SCE(+SDOE,0))

           SET SDCL=+$PIECE(SDOE0,"^",4)

           SET SDORG=+$PIECE(SDOE0,"^",8)

 +5        IF $$REQ^SDM1A(+SDOE0)'="CO"

               GOTO PRASKQ

 +6        IF SDORG=1

               IF '$$CLINIC^SDAMU(SDCL)

                   GOTO PRASKQ

 +7       ;I "^1^2^"[("^"_SDORG_"^"),$$INP^SDAM2(+$P(SDOE0,"^",2),+SDOE0)="I" G PRASKQ  ;SD*5.3*466 allow provider check for inpatients 

 +8        IF +SDOE0<2961001

               SET Y=2

               GOTO PRASKQ

 +9        IF SDCL

               SET Y=1

               GOTO PRASKQ

 +10       IF SDORG=3

               SET Y=1

PRASKQ     QUIT +$GET(Y)

 +1       ;

SET(SDOE) ;Set-up Provider Array for Outpatient Encounter

 +1       ; Input  -- SDOE      Outpatient Encounter IEN

 +2       ; Output -- SDPRY     Provider Array Subscripted by a Number

 +3       ;           SDCNT     Number of Array Entries

 +4        NEW SDVA200,SDVPRV,SDPRVS

 +5        KILL SDPRY

 +6        DO GETPRV^SDOE(SDOE,"SDPRVS")

 +7        SET (SDCNT,SDVPRV)=0

 +8        FOR 

               SET SDVPRV=$ORDER(SDPRVS(SDVPRV))

               IF 'SDVPRV

                   QUIT 

               Begin DoDot:1

 +9                SET SDVA200=+$GET(SDPRVS(SDVPRV))

 +10               SET SDCNT=SDCNT+1

 +11               SET SDPRY(SDCNT)=SDVPRV_"^"_SDVA200

               End DoDot:1

SETQ       QUIT 

 +1       ;

LIST(SDPRY) ;List Provider Array

 +1       ; Input  -- SDPRY     Provider Array Subscripted by a Number

 +2       ; Output -- List Provider Array

 +3        NEW I

 +4        WRITE !

 +5        SET I=0

           FOR 

               SET I=$ORDER(SDPRY(I))

               IF 'I

                   QUIT 

               WRITE !?2,I,"  ",$$PR^SDCO31(+$PIECE(SDPRY(I),"^",2))

 +6        QUIT 

 +7       ;

EDITOK(SDOE,SDMODE) ; -- ok to edit?

 +1       ; input:  SDOE   := ien of 409.68                  [required]

 +2       ;         SDMODE := 1 -- interactive ; 0 -- silent [required]

 +3       ;

 +4       ; returned:  1 -- yes, it's ok to edit or delete SDOE entry

 +5       ;            0 -- no, cannot not change SDOE entry

 +6       ;

 +7        NEW DIR,SDOK

 +8        SET SDOK=$$NEW^SDPCE($PIECE($GET(^SCE(+$GET(SDOE),0)),U))

 +9        IF 'SDOK

               IF SDMODE

                   DO OLDMSG

EDITOKQ    QUIT SDOK

 +1       ;

OLDMSG    ; -- display message to user

 +1        WRITE !!,">>> Editing and deleting old encounters not allowed.",!

 +2        NEW DIR

 +3        SET DIR(0)="E"

 +4        SET DIR("A")="Press Return key to continue"

 +5        DO ^DIR

 +6        QUIT 

 +7       ;