source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCCVCST5.m@ 1806

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

initial load of WorldVistAEHR

File size: 3.0 KB
RevLine 
[613]1SCCVCST5 ;ALB/TMP - Scheduling Conversion Template Utilities - CST; APR 20, 1998
2 ;;5.3;Scheduling;**211**;Aug 13, 1993
3 ;
4VAL1(SCCVEVT,SCFILE,SCCVDA,SCMULT) ;Validate that entry selected can be converted
5 ;
6 N OK,DATA,SCERR,SCCLN,ENC,SCF
7 S OK=0,DATA=$G(@SCFILE@(SCCVDA,0))
8 S SCF=SCFILE
9 ;
10 I DATA="" S SCERR=1 G VAL1Q
11 ;
12 I SCFILE["SCE" D G:$G(SCERR)!(SCF["SDV") VAL1Q
13 . ; Encounter - change SCF,SCCVDA,DATA for enctr type
14 . I DATA>SCCVACRP S SCERR=2 Q ;Date must be before 10-1-96
15 . I SCCVEVT=1,$P(DATA,U,5) S SCERR=3 Q ;Can't already have a visit
16 . I SCCVEVT=2,'$P($G(^SCE(SCCVDA,"CNV")),U,4) S SCERR=8 Q ;Must be converted to reconvert
17 . I $P(DATA,U,6)!($P(DATA,U,8)>3) S SCERR=4 Q ;Can't convert a child encounter
18 . S SCF=$$SETFL^SCCVCST3($P(DATA,U,8),SCCVDFN)
19 . I SCF["SDV" S OK=1 Q ;No further checks needed for A/E
20 . S SCCVDA=+DATA
21 . S:SCF["""DIS""" SCCVDA=9999999-SCCVDA
22 . S DATA=$G(@SCF@(SCCVDA,0))
23 . S:DATA="" SCERR=1
24 ;
25 I SCF["""DIS""" D G VAL1Q ; Disposition
26 . I SCCVEVT=2 S ENC=$P(DATA,U,18) D Q
27 .. I '$P(DATA,U,19)!'$P($G(^SCE(ENC,"CNV")),U,4) S SCERR=8 Q ;Must be converted to reconvert
28 .. S OK=1
29 . ;
30 . I SCCVEVT=1,$P(DATA,U,18),$P($G(^SCE(+$P(DATA,U,18),0)),U,5) S SCERR=3 Q
31 . IF SCCVEVT=1,$$REQ^SDM1A(+DATA)="CO",'$P($G(^SCE(+$P(DATA,U,18),0)),U,7) S SCERR=9 Q ; Must be checked out
32 . I $P(DATA,U,2)=2 S SCERR=5 Q ;Must be dispositioned properly
33 . S OK=1
34 ;
35 I SCF["""S""" D G VAL1Q ; Appt
36 . I SCCVEVT=2 S ENC=+$P(DATA,U,20) D Q
37 .. I '$P(DATA,U,23)!'$P($G(^SCE(ENC,"CNV")),U,4) S SCERR=8 Q ;Must be converted to reconvert
38 .. S OK=1
39 . ;
40 . I SCCVEVT=1,$P(DATA,U,20),$P($G(^SCE(+$P(DATA,U,20),0)),U,5) S SCERR=3 Q
41 . IF SCCVEVT=1,$$REQ^SDM1A(SCCVDA)="CO",'$P($G(^SCE(+$P(DATA,U,20),0)),U,7) S SCERR=9 Q ; Must be checked out
42 . I $P(DATA,U,2)'="",$P(DATA,U,2)'="I",$P(DATA,U,2)'="NT" S SCERR=6 Q ; Can't be 'unfinished' status
43 . I $P($G(^SC(+DATA,0)),U,3)'="C" S SCERR=7 Q ;Must be clinic
44 . S OK=1
45 ;
46 I SCF["SDV",SCF=SCFILE D G VAL1Q ; Full standalone add/edit
47 . N SCCS,DATA1,STAT
48 . S SCCS=0 F S SCCS=$O(@SCF@(SCCVDA,"CS",SCCS)) Q:'SCCS S DATA1=$G(^(SCCS,0)) W "." D Q:OK
49 .. S ENC=+$P(DATA1,U,8)
50 .. ; In 'CS' nodes at least one entry must:
51 .. ; - be a non-child encounter (error 4)
52 .. ; - have no encounter or no visit if converting (error 3)
53 .. ; - have already been converted if reconverting (error 8)
54 .. ; - must be checked out if requred (error 9)
55 .. ;
56 .. S STAT=0
57 .. IF 'STAT,$P($G(^SCE(ENC,0)),U,6) S STAT=4 ; -- not child check
58 .. ;
59 .. IF 'STAT,SCCVEVT=1 D
60 ... IF 'ENC Q ; -- no encounter check
61 ... IF $P($G(^SCE(ENC,0)),U,5) S STAT=3 Q ; -- no visit check
62 .. ;
63 .. IF 'STAT,SCCVEVT'=1 D
64 ... IF '$P($G(^SCE(ENC,"CNV")),U,4)!'$P(DATA1,U,9) S STAT=8 ; -- must be already converted check
65 .. ;
66 .. IF 'STAT,$$REQ^SDM1A(SCCVDA)="CO",'$P($G(^SCE(+ENC,0)),U,7) S STAT=9 ; -- must be checked out check
67 .. ;
68 .. I 'STAT K SCERR S OK=1 Q ; -- at least one node passes
69 .. S SCERR(STAT)=""
70 ;
71VAL1Q I $G(SCMULT) K SCERR
72 I $D(SCERR) D DISPERR^SCCVCST4(.SCERR,SCF) S OK=0
73 Q OK
74 ;
Note: See TracBrowser for help on using the repository browser.