source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDCO3.m@ 1361

Last change on this file since 1361 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1SDCO3 ;ALB/RMO - Provider - Check Out;08 DEC 1992 4:05 pm
2 ;;5.3;Scheduling;**28,27,44,67,71,132,466**;08/13/93;Build 2
3 ;
4EN ;Entry point for SDCO PROVIDER protocol
5 ; Input -- SDOE
6 ;
7 S VALMBCK=""
8 ;
9 ; -- if OLD encounter, quit
10 IF '$$EDITOK($G(SDOE),1) G ENQ
11 ;
12 ; -- call PCE interview
13 N SDVISIT,SDHL
14 S SDVISIT=$P($G(^SCE(+SDOE,0)),U,5)
15 S X=$$INTV^PXAPI("PRV","SD","PIMS",SDVISIT)
16 D BLD^SDCO S VALMBCK="R"
17ENQ Q
18 ;
19PRASK(SDOE) ;Ask Provider on Check Out
20 ; Input -- SDOE Outpatient Encounter IEN
21 ; Output -- 0=No, 1=Yes/Required, 2=Yes/Not Required
22 N SDCL,SDOE0,SDORG,Y
23 S SDOE0=$G(^SCE(+SDOE,0)),SDCL=+$P(SDOE0,"^",4),SDORG=+$P(SDOE0,"^",8)
24 I $$REQ^SDM1A(+SDOE0)'="CO" G PRASKQ
25 I SDORG=1,'$$CLINIC^SDAMU(SDCL) G PRASKQ
26 ;I "^1^2^"[("^"_SDORG_"^"),$$INP^SDAM2(+$P(SDOE0,"^",2),+SDOE0)="I" G PRASKQ ;SD*5.3*466 allow provider check for inpatients
27 I +SDOE0<2961001 S Y=2 G PRASKQ
28 I SDCL S Y=1 G PRASKQ
29 I SDORG=3 S Y=1
30PRASKQ Q +$G(Y)
31 ;
32SET(SDOE) ;Set-up Provider Array for Outpatient Encounter
33 ; Input -- SDOE Outpatient Encounter IEN
34 ; Output -- SDPRY Provider Array Subscripted by a Number
35 ; SDCNT Number of Array Entries
36 N SDVA200,SDVPRV,SDPRVS
37 K SDPRY
38 D GETPRV^SDOE(SDOE,"SDPRVS")
39 S (SDCNT,SDVPRV)=0
40 F S SDVPRV=$O(SDPRVS(SDVPRV)) Q:'SDVPRV D
41 . S SDVA200=+$G(SDPRVS(SDVPRV))
42 . S SDCNT=SDCNT+1
43 . S SDPRY(SDCNT)=SDVPRV_"^"_SDVA200
44SETQ Q
45 ;
46LIST(SDPRY) ;List Provider Array
47 ; Input -- SDPRY Provider Array Subscripted by a Number
48 ; Output -- List Provider Array
49 N I
50 W !
51 S I=0 F S I=$O(SDPRY(I)) Q:'I W !?2,I," ",$$PR^SDCO31(+$P(SDPRY(I),"^",2))
52 Q
53 ;
54EDITOK(SDOE,SDMODE) ; -- ok to edit?
55 ; input: SDOE := ien of 409.68 [required]
56 ; SDMODE := 1 -- interactive ; 0 -- silent [required]
57 ;
58 ; returned: 1 -- yes, it's ok to edit or delete SDOE entry
59 ; 0 -- no, cannot not change SDOE entry
60 ;
61 N DIR,SDOK
62 S SDOK=$$NEW^SDPCE($P($G(^SCE(+$G(SDOE),0)),U))
63 IF 'SDOK,SDMODE D OLDMSG
64EDITOKQ Q SDOK
65 ;
66OLDMSG ; -- display message to user
67 W !!,">>> Editing and deleting old encounters not allowed.",!
68 N DIR
69 S DIR(0)="E"
70 S DIR("A")="Press Return key to continue"
71 D ^DIR
72 Q
73 ;
Note: See TracBrowser for help on using the repository browser.