source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDCO4.m@ 824

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1SDCO4 ;ALB/RMO - Diagnosis - Check Out;08 DEC 1992 4:05 pm
2 ;;5.3;Scheduling;**32,27,44,67,77,85,132,466**;08/13/93;Build 2
3 ;
4EN ;Entry point for SDCO DIAGNOSIS protocol
5 ; Input -- SDOE
6 ;
7 S VALMBCK=""
8 ;
9 ; -- if OLD encounter, quit
10 IF '$$EDITOK^SDCO3($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("POV","SD","PIMS",SDVISIT)
16 D BLD^SDCO S VALMBCK="R"
17ENQ Q
18 ;
19DXASK(SDOE) ;Ask Diagnosis 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 DXASKQ
25 I $$OCASN(SDOE) G DXASKQ
26 I SDORG=1,'$$CLINIC^SDAMU(SDCL) G DXASKQ
27 ;I "^1^2^"[("^"_SDORG_"^"),$$INP^SDAM2(+$P(SDOE0,"^",2),+SDOE0)="I" G DXASKQ ;SD*5.3*466 allow diagnosis check for inpatients
28 I +SDOE0<2961001 S Y=2 G DXASKQ
29 I SDCL S Y=1 G DXASKQ
30 I SDORG=3 S Y=1
31DXASKQ Q +$G(Y)
32 ;
33OCASN(SDOE) ;determines if this is an occasion of service.
34 ; returns a 1 if and occasion 0 if not
35 ;
36 N ANS
37 S ANS=$$CHKOCC^SCMSVDG1(SDOE)
38 Q +$G(ANS)
39 ;
40SET(SDOE) ;Set-up Diagnosis Array for Outpatient Encounter
41 ; Input -- SDOE Outpatient Encounter IEN
42 ; Output -- SDDXY Diagnosis Array Subscripted by a Number
43 ; SDCNT Number of Array Entries
44 N SDICD9,SDVPOV,SDDXS
45 K SDDXY
46 D GETDX^SDOE(SDOE,"SDDXS")
47 S (SDCNT,SDVPOV)=0
48 F S SDVPOV=$O(SDDXS(SDVPOV)) Q:'SDVPOV D
49 . S SDICD9=+$G(SDDXS(SDVPOV))
50 . S SDCNT=SDCNT+1
51 . S SDDXY(SDCNT)=SDVPOV_"^"_SDICD9
52SETQ Q
53 ;
54LIST(SDDXY) ;List Diagnosis Array
55 ; Input -- SDDXY Diagnosis Array Subscripted by a Number
56 ; Output -- List Diagnosis Array
57 N I,SDDXD
58 W !
59 S I=0 F S I=$O(SDDXY(I)) Q:'I S SDDXD=$$DX^SDCO41(+$P(SDDXY(I),"^",2)) W !?2,I," ",$P(SDDXD,"^"),?15,$P(SDDXD,"^",2)
60 Q
61 ;
Note: See TracBrowser for help on using the repository browser.