SDCO3 ;ALB/RMO - Provider - Check Out;08 DEC 1992 4:05 pm
;;5.3;Scheduling;**28,27,44,67,71,132,466,717**;08/13/93;Build 12
;
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=1 D OLDMSG ;*zeb 10/25/18 717 support SDMODE=2 for GUI
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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCO3 2316 printed Apr 09, 2024@21:47:54 Page 2
SDCO3 ;ALB/RMO - Provider - Check Out;08 DEC 1992 4:05 pm
+1 ;;5.3;Scheduling;**28,27,44,67,71,132,466,717**;08/13/93;Build 12
+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 ;*zeb 10/25/18 717 support SDMODE=2 for GUI
IF 'SDOK
IF SDMODE=1
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 ;
