source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAPICO1.m@ 1141

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

initial load of WorldVistAEHR

File size: 3.1 KB
RevLine 
[613]1SDAPICO1 ;ALB/MJK - API - Common Check-Out Processing;04 MAR 1993 10:00 am
2 ;;5.3;Scheduling;**27**;08/13/93
3 ;
4CLASS(SDOE) ; -- file classification data
5 IF '$D(@SDROOT@("CLASSIFICATION")) G CLASSQ
6 N SDCLOEY,I,SDCTIS,SDCTS,SDVAL,SDCTVAL,SDCT,SDCT0,SDCTI,SDCTAB,SDACT
7 ; -- find class required for this encounter
8 D CLASK^SDCO2(SDOE,.SDCLOEY)
9 ;
10 ; -- get class abbreviations
11 S SDCTI=0 F S SDCTI=$O(^SD(409.41,SDCTI)) Q:'SDCTI S SDCTAB($P(^(SDCTI,0),U,7))=SDCTI
12 ;
13 ; -- process deletions
14 IF $D(SDCLOEY),$D(@SDROOT@("CLASSIFICATION","DELETE")) D
15 . S SDCT=""
16 . F S SDCT=$O(@SDROOT@("CLASSIFICATION","DELETE",SDCT)) Q:SDCT="" D
17 .. ; -- valid class
18 .. S SDCTI=$$VALID(SDCT,.SDCTAB) Q:'SDCTI
19 .. ; -- delete co completion date ; delete class entry ; send warning
20 .. D COMDT^SDCODEL(SDOE),DEL^SDAPICO(SDOE,409.42,SDCTI),ERRFILE^SDAPIER(1045)
21 ;
22 ; -- warning if class data not required but passed
23 IF '$D(SDCLOEY),$D(@SDROOT@("CLASSIFICATION","ADD"))!($D(@SDROOT@("CLASSIFICATION","CHANGE"))) D ERRFILE^SDAPIER(1040) G CLASSQ
24 ;
25 F SDACT="ADD","CHANGE" D
26 . S SDCT=""
27 . F S SDCT=$O(@SDROOT@("CLASSIFICATION",SDACT,SDCT)) Q:SDCT="" D
28 .. S SDVAL=@SDROOT@("CLASSIFICATION",SDACT,SDCT)
29 .. ; -- valid class abbrev passed
30 .. S SDCTI=$$VALID(SDCT,.SDCTAB) Q:'SDCTI
31 .. ; -- vaild format for class value passed
32 .. S SDCT0=$G(^SD(409.41,SDCTI,0))
33 .. IF '$$CHKVAL(SDCT0,.SDVAL) D ERRFILE^SDAPIER(1044,$P(SDCT0,U)_U_SDVAL) Q
34 .. S SDCTVAL(SDCTI)=SDVAL
35 .. ; -- if change to sc class then delete c/o process date & send warning
36 .. IF SDCTI=3,$G(SDCLOEY(3)),$P(SDCLOEY(3),U,2)]"",SDCTVAL(3)'=$P(SDCLOEY(3),U,2) D COMDT^SDCODEL(SDOE),ERRFILE^SDAPIER(1046)
37 ;
38 ; -- get required sequence to file class (ie. force sc to be 1st)
39 S SDCTIS=$$SEQ^SDCO21
40 F SDCTS=1:1 S SDCTI=+$P(SDCTIS,",",SDCTS) Q:'SDCTI!($D(SDCOQUIT)) D
41 . ; -- check to see if specific class is needed
42 . IF $D(SDCTVAL(SDCTI)),'$D(SDCLOEY(SDCTI)) D ERRFILE^SDAPIER(1047,$P($G(^SD(409.41,SDCTI,0)),U,7)) Q
43 . ; process specific class
44 . IF $D(SDCLOEY(SDCTI)) D
45 .. D ONE(SDCTI,SDCLOEY(SDCTI),SDOE,$G(SDCTVAL(SDCTI)))
46 .. ; -- if service connected class do consistency checks
47 .. IF SDCTI=3 F I=1,2,4 D SC^SDCO21(I,SDOE,"",.SDCLOEY)
48CLASSQ Q
49 ;
50VALID(SDCT,SDCTAB) ; -- warning if not a valid class passed
51 N SDCTI
52 S SDCTI=+$G(SDCTAB(SDCT))
53 IF 'SDCTI D ERRFILE^SDAPIER(1041,SDCT)
54 Q SDCTI
55 ;
56ONE(SDCTI,SDATA,SDOE,SDVAL) ;Process One Classification at a time
57 ; Input -- SDCTI Outpatient Classification Type IEN
58 ; SDATA Null or 409.42 IEN^Internal Value^1=n/a^1=unedt
59 ; SDOE Outpatient Encounter file IEN
60 ; Output -- <none>
61 ;
62 N SDCT0,DIK,DA
63 S SDCT0=$G(^SD(409.41,SDCTI,0)) G ONEQ:SDCT0']""
64 ; -- no longer applicable
65 IF SDATA,$P(SDATA,"^",3) D G ONEQ
66 . N DIK,DA
67 . S DA=+SDATA,DIK="^SDD(409.42," D ^DIK
68 . D ERRFILE^SDAPIER(1042,$P(SDCT0,U))
69 ; -- uneditable
70 IF SDATA,$P(SDATA,"^",4) D ERRFILE^SDAPIER(1043,$P(SDCT0,U)) G ONEQ
71 ; -- file data
72 IF SDVAL]"" D FILE^SDCO20(+SDATA,SDVAL)
73ONEQ Q
74 ;
75CHKVAL(SDCT0,SDVAL) ; -- validate classification value and convert
76 N Y,SDTYPE
77 S SDTYPE=$P(SDCT0,U,3),Y=0
78 IF SDTYPE="Y",SDVAL="Y"!(SDVAL="N") S Y=1,SDVAL=$S(SDVAL="Y":1,1:0)
79 IF SDTYPE="N",SDVAL=+SDVAL S Y=1
80 Q Y
81 ;
Note: See TracBrowser for help on using the repository browser.