SCCVCST5 ;ALB/TMP - Scheduling Conversion Template Utilities - CST; APR 20, 1998
;;5.3;Scheduling;**211**;Aug 13, 1993
;
VAL1(SCCVEVT,SCFILE,SCCVDA,SCMULT) ;Validate that entry selected can be converted
;
N OK,DATA,SCERR,SCCLN,ENC,SCF
S OK=0,DATA=$G(@SCFILE@(SCCVDA,0))
S SCF=SCFILE
;
I DATA="" S SCERR=1 G VAL1Q
;
I SCFILE["SCE" D G:$G(SCERR)!(SCF["SDV") VAL1Q
. ; Encounter - change SCF,SCCVDA,DATA for enctr type
. I DATA>SCCVACRP S SCERR=2 Q ;Date must be before 10-1-96
. I SCCVEVT=1,$P(DATA,U,5) S SCERR=3 Q ;Can't already have a visit
. I SCCVEVT=2,'$P($G(^SCE(SCCVDA,"CNV")),U,4) S SCERR=8 Q ;Must be converted to reconvert
. I $P(DATA,U,6)!($P(DATA,U,8)>3) S SCERR=4 Q ;Can't convert a child encounter
. S SCF=$$SETFL^SCCVCST3($P(DATA,U,8),SCCVDFN)
. I SCF["SDV" S OK=1 Q ;No further checks needed for A/E
. S SCCVDA=+DATA
. S:SCF["""DIS""" SCCVDA=9999999-SCCVDA
. S DATA=$G(@SCF@(SCCVDA,0))
. S:DATA="" SCERR=1
;
I SCF["""DIS""" D G VAL1Q ; Disposition
. I SCCVEVT=2 S ENC=$P(DATA,U,18) D Q
.. I '$P(DATA,U,19)!'$P($G(^SCE(ENC,"CNV")),U,4) S SCERR=8 Q ;Must be converted to reconvert
.. S OK=1
. ;
. I SCCVEVT=1,$P(DATA,U,18),$P($G(^SCE(+$P(DATA,U,18),0)),U,5) S SCERR=3 Q
. 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
. I $P(DATA,U,2)=2 S SCERR=5 Q ;Must be dispositioned properly
. S OK=1
;
I SCF["""S""" D G VAL1Q ; Appt
. I SCCVEVT=2 S ENC=+$P(DATA,U,20) D Q
.. I '$P(DATA,U,23)!'$P($G(^SCE(ENC,"CNV")),U,4) S SCERR=8 Q ;Must be converted to reconvert
.. S OK=1
. ;
. I SCCVEVT=1,$P(DATA,U,20),$P($G(^SCE(+$P(DATA,U,20),0)),U,5) S SCERR=3 Q
. 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
. I $P(DATA,U,2)'="",$P(DATA,U,2)'="I",$P(DATA,U,2)'="NT" S SCERR=6 Q ; Can't be 'unfinished' status
. I $P($G(^SC(+DATA,0)),U,3)'="C" S SCERR=7 Q ;Must be clinic
. S OK=1
;
I SCF["SDV",SCF=SCFILE D G VAL1Q ; Full standalone add/edit
. N SCCS,DATA1,STAT
. S SCCS=0 F S SCCS=$O(@SCF@(SCCVDA,"CS",SCCS)) Q:'SCCS S DATA1=$G(^(SCCS,0)) W "." D Q:OK
.. S ENC=+$P(DATA1,U,8)
.. ; In 'CS' nodes at least one entry must:
.. ; - be a non-child encounter (error 4)
.. ; - have no encounter or no visit if converting (error 3)
.. ; - have already been converted if reconverting (error 8)
.. ; - must be checked out if requred (error 9)
.. ;
.. S STAT=0
.. IF 'STAT,$P($G(^SCE(ENC,0)),U,6) S STAT=4 ; -- not child check
.. ;
.. IF 'STAT,SCCVEVT=1 D
... IF 'ENC Q ; -- no encounter check
... IF $P($G(^SCE(ENC,0)),U,5) S STAT=3 Q ; -- no visit check
.. ;
.. IF 'STAT,SCCVEVT'=1 D
... IF '$P($G(^SCE(ENC,"CNV")),U,4)!'$P(DATA1,U,9) S STAT=8 ; -- must be already converted check
.. ;
.. IF 'STAT,$$REQ^SDM1A(SCCVDA)="CO",'$P($G(^SCE(+ENC,0)),U,7) S STAT=9 ; -- must be checked out check
.. ;
.. I 'STAT K SCERR S OK=1 Q ; -- at least one node passes
.. S SCERR(STAT)=""
;
VAL1Q I $G(SCMULT) K SCERR
I $D(SCERR) D DISPERR^SCCVCST4(.SCERR,SCF) S OK=0
Q OK
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCCVCST5 3196 printed Oct 16, 2024@18:39:10 Page 2
SCCVCST5 ;ALB/TMP - Scheduling Conversion Template Utilities - CST; APR 20, 1998
+1 ;;5.3;Scheduling;**211**;Aug 13, 1993
+2 ;
VAL1(SCCVEVT,SCFILE,SCCVDA,SCMULT) ;Validate that entry selected can be converted
+1 ;
+2 NEW OK,DATA,SCERR,SCCLN,ENC,SCF
+3 SET OK=0
SET DATA=$GET(@SCFILE@(SCCVDA,0))
+4 SET SCF=SCFILE
+5 ;
+6 IF DATA=""
SET SCERR=1
GOTO VAL1Q
+7 ;
+8 IF SCFILE["SCE"
Begin DoDot:1
+9 ; Encounter - change SCF,SCCVDA,DATA for enctr type
+10 ;Date must be before 10-1-96
IF DATA>SCCVACRP
SET SCERR=2
QUIT
+11 ;Can't already have a visit
IF SCCVEVT=1
IF $PIECE(DATA,U,5)
SET SCERR=3
QUIT
+12 ;Must be converted to reconvert
IF SCCVEVT=2
IF '$PIECE($GET(^SCE(SCCVDA,"CNV")),U,4)
SET SCERR=8
QUIT
+13 ;Can't convert a child encounter
IF $PIECE(DATA,U,6)!($PIECE(DATA,U,8)>3)
SET SCERR=4
QUIT
+14 SET SCF=$$SETFL^SCCVCST3($PIECE(DATA,U,8),SCCVDFN)
+15 ;No further checks needed for A/E
IF SCF["SDV"
SET OK=1
QUIT
+16 SET SCCVDA=+DATA
+17 if SCF["""DIS"""
SET SCCVDA=9999999-SCCVDA
+18 SET DATA=$GET(@SCF@(SCCVDA,0))
+19 if DATA=""
SET SCERR=1
End DoDot:1
if $GET(SCERR)!(SCF["SDV")
GOTO VAL1Q
+20 ;
+21 ; Disposition
IF SCF["""DIS"""
Begin DoDot:1
+22 IF SCCVEVT=2
SET ENC=$PIECE(DATA,U,18)
Begin DoDot:2
+23 ;Must be converted to reconvert
IF '$PIECE(DATA,U,19)!'$PIECE($GET(^SCE(ENC,"CNV")),U,4)
SET SCERR=8
QUIT
+24 SET OK=1
End DoDot:2
QUIT
+25 ;
+26 IF SCCVEVT=1
IF $PIECE(DATA,U,18)
IF $PIECE($GET(^SCE(+$PIECE(DATA,U,18),0)),U,5)
SET SCERR=3
QUIT
+27 ; Must be checked out
IF SCCVEVT=1
IF $$REQ^SDM1A(+DATA)="CO"
IF '$PIECE($GET(^SCE(+$PIECE(DATA,U,18),0)),U,7)
SET SCERR=9
QUIT
+28 ;Must be dispositioned properly
IF $PIECE(DATA,U,2)=2
SET SCERR=5
QUIT
+29 SET OK=1
End DoDot:1
GOTO VAL1Q
+30 ;
+31 ; Appt
IF SCF["""S"""
Begin DoDot:1
+32 IF SCCVEVT=2
SET ENC=+$PIECE(DATA,U,20)
Begin DoDot:2
+33 ;Must be converted to reconvert
IF '$PIECE(DATA,U,23)!'$PIECE($GET(^SCE(ENC,"CNV")),U,4)
SET SCERR=8
QUIT
+34 SET OK=1
End DoDot:2
QUIT
+35 ;
+36 IF SCCVEVT=1
IF $PIECE(DATA,U,20)
IF $PIECE($GET(^SCE(+$PIECE(DATA,U,20),0)),U,5)
SET SCERR=3
QUIT
+37 ; Must be checked out
IF SCCVEVT=1
IF $$REQ^SDM1A(SCCVDA)="CO"
IF '$PIECE($GET(^SCE(+$PIECE(DATA,U,20),0)),U,7)
SET SCERR=9
QUIT
+38 ; Can't be 'unfinished' status
IF $PIECE(DATA,U,2)'=""
IF $PIECE(DATA,U,2)'="I"
IF $PIECE(DATA,U,2)'="NT"
SET SCERR=6
QUIT
+39 ;Must be clinic
IF $PIECE($GET(^SC(+DATA,0)),U,3)'="C"
SET SCERR=7
QUIT
+40 SET OK=1
End DoDot:1
GOTO VAL1Q
+41 ;
+42 ; Full standalone add/edit
IF SCF["SDV"
IF SCF=SCFILE
Begin DoDot:1
+43 NEW SCCS,DATA1,STAT
+44 SET SCCS=0
FOR
SET SCCS=$ORDER(@SCF@(SCCVDA,"CS",SCCS))
if 'SCCS
QUIT
SET DATA1=$GET(^(SCCS,0))
WRITE "."
Begin DoDot:2
+45 SET ENC=+$PIECE(DATA1,U,8)
+46 ; In 'CS' nodes at least one entry must:
+47 ; - be a non-child encounter (error 4)
+48 ; - have no encounter or no visit if converting (error 3)
+49 ; - have already been converted if reconverting (error 8)
+50 ; - must be checked out if requred (error 9)
+51 ;
+52 SET STAT=0
+53 ; -- not child check
IF 'STAT
IF $PIECE($GET(^SCE(ENC,0)),U,6)
SET STAT=4
+54 ;
+55 IF 'STAT
IF SCCVEVT=1
Begin DoDot:3
+56 ; -- no encounter check
IF 'ENC
QUIT
+57 ; -- no visit check
IF $PIECE($GET(^SCE(ENC,0)),U,5)
SET STAT=3
QUIT
End DoDot:3
+58 ;
+59 IF 'STAT
IF SCCVEVT'=1
Begin DoDot:3
+60 ; -- must be already converted check
IF '$PIECE($GET(^SCE(ENC,"CNV")),U,4)!'$PIECE(DATA1,U,9)
SET STAT=8
End DoDot:3
+61 ;
+62 ; -- must be checked out check
IF 'STAT
IF $$REQ^SDM1A(SCCVDA)="CO"
IF '$PIECE($GET(^SCE(+ENC,0)),U,7)
SET STAT=9
+63 ;
+64 ; -- at least one node passes
IF 'STAT
KILL SCERR
SET OK=1
QUIT
+65 SET SCERR(STAT)=""
End DoDot:2
if OK
QUIT
End DoDot:1
GOTO VAL1Q
+66 ;
VAL1Q IF $GET(SCMULT)
KILL SCERR
+1 IF $DATA(SCERR)
DO DISPERR^SCCVCST4(.SCERR,SCF)
SET OK=0
+2 QUIT OK
+3 ;
