SCCVEAE.m

SCCVEAE ;ALB/RMO,TMP - Add/Edit Conversion; [ 03/31/95  3:11 PM ]

 ;;5.3;Scheduling;**211,1015**;Aug 13, 1993;Build 21

 ;

EN(SCCVEVT,SCSTDT,SCENDT,SCLOG,SCREQ,SCSTOPF) ;Entry point to loop through all add/edits for a specified date range

 ; Input  -- SCCVEVT  Conversion event

 ;           SCSTST   Start date

 ;           SCENDT   End date

 ;           SCLOG    Scheduling conversion log IEN

 ;           SCREQ    Scheduling conversion request IEN

 ; Output -- SCSTOPF  Conversion stop flag

 N SCDTM

 F SCDTM=SCSTDT:0 S SCDTM=$O(^SDV(SCDTM)) Q:'SCDTM!($P(SCDTM,".")>SCENDT)!($G(SCSTOPF))  D STOPS(SCCVEVT,SCDTM,SCLOG,SCREQ,.SCSTOPF)

ENQ Q

 ;

STOPS(SCCVEVT,SCDTM,SCLOG,SCREQ,SCSTOPF) ;Loop through stop codes for a specific date/time

 ; Input  -- SCCVEVT  Conversion event

 ;           SCDTM    Visit date/time

 ;           SCLOG    Scheduling conversion log IEN

 ;           SCREQ    Scheduling conversion request IEN

 ; Output -- SCSTOPF  Conversion stop flag

 N SCDA,SCQUIT,SC0,SCE,SCE0,X

 IF SCCVEVT D ZERO(SCDTM)

 S SCDA=0

 F  S SCDA=$O(^SDV(SCDTM,"CS",SCDA)) Q:'SCDA!($G(SCSTOPF))  I $D(^SDV(SCDTM,"CS",SCDA,0)) S SC0=^(0),SCQUIT=0 D

 .I $P(SC0,U,8) D  Q:SCQUIT  ; Is 'parent encounter' invalid?

 .. S SCE=+$P($G(^SCE(+$P(SC0,U,8),0)),U,6)

 .. Q:'SCE  ;Encounter IS a parent, so it's OK to process

 .. ;Check parents of children for validity

 .. S SCE0=$G(^SCE(SCE,0))

 .. ;

 .. ;'Estimate' processes Add/Edit data separate from 'parent' to avoid counting them twice, so the following checks are necessary to be sure the parent was a valid appt

 .. I $P(SCE0,U,8)=1 S X=$G(^DPT(+$P(SCE0,U,2),"S",+SCE0,0)) IF $P(X,U,2)'="",$P(X,U,2)'="I" S SCQUIT=1 Q  ;Don't convert or add to estimate counts if children of an invalid appt

 .. I $P(SCE0,U,8)=3 S X=$G(^DPT(+$P(SCE0,U,2),"DIS",9999999-SCE0,0)) IF $P(X,U,2)=2 S SCQUIT=1 Q  ;Don't convert or add to estimate counts if children of an invalid disposition

 .. IF $P(SCE0,U,5),'$P($G(^SCE(SCE,"CNV")),U,4) S SCQUIT=1 Q  ; -- visit already exists / not historial visit 

 .. I SCCVEVT,'$P(SCE0,U,5) S SCQUIT=1 ;Parent has no visit, don't convert children

 .. ;

 . D EN^SCCVEAE1(SCCVEVT,SCDTM,SCDA,0,SCLOG)

 . I $G(SCLOG) D STOP^SCCVLOG(SCLOG,SCREQ,.SCSTOPF)

 . I '$G(SCLOG) S SCTOT("OK")=1

STOPQ Q

 ;

ZERO(SCDTM) ; -- fix zeroth if missing

 IF '$D(^SDV(SCDTM,"CS",0)),$O(^SDV(SCDTM,"CS",0)) S ^SDV(SCDTM,"CS",0)="^409.51P^^"

 Q

 ;

SCCVEAE   ;ALB/RMO,TMP - Add/Edit Conversion; [ 03/31/95  3:11 PM ]

 +1       ;;5.3;Scheduling;**211,1015**;Aug 13, 1993;Build 21

 +2       ;

EN(SCCVEVT,SCSTDT,SCENDT,SCLOG,SCREQ,SCSTOPF) ;Entry point to loop through all add/edits for a specified date range

 +1       ; Input  -- SCCVEVT  Conversion event

 +2       ;           SCSTST   Start date

 +3       ;           SCENDT   End date

 +4       ;           SCLOG    Scheduling conversion log IEN

 +5       ;           SCREQ    Scheduling conversion request IEN

 +6       ; Output -- SCSTOPF  Conversion stop flag

 +7        NEW SCDTM

 +8        FOR SCDTM=SCSTDT:0

               SET SCDTM=$ORDER(^SDV(SCDTM))

               IF 'SCDTM!($PIECE(SCDTM,".")>SCENDT)!($GET(SCSTOPF))

                   QUIT 

               DO STOPS(SCCVEVT,SCDTM,SCLOG,SCREQ,.SCSTOPF)

ENQ        QUIT 

 +1       ;

STOPS(SCCVEVT,SCDTM,SCLOG,SCREQ,SCSTOPF) ;Loop through stop codes for a specific date/time

 +1       ; Input  -- SCCVEVT  Conversion event

 +2       ;           SCDTM    Visit date/time

 +3       ;           SCLOG    Scheduling conversion log IEN

 +4       ;           SCREQ    Scheduling conversion request IEN

 +5       ; Output -- SCSTOPF  Conversion stop flag

 +6        NEW SCDA,SCQUIT,SC0,SCE,SCE0,X

 +7        IF SCCVEVT

               DO ZERO(SCDTM)

 +8        SET SCDA=0

 +9        FOR 

               SET SCDA=$ORDER(^SDV(SCDTM,"CS",SCDA))

               IF 'SCDA!($GET(SCSTOPF))

                   QUIT 

               IF $DATA(^SDV(SCDTM,"CS",SCDA,0))

                   SET SC0=^(0)

                   SET SCQUIT=0

                   Begin DoDot:1

 +10      ; Is 'parent encounter' invalid?

                       IF $PIECE(SC0,U,8)

                           Begin DoDot:2

 +11                           SET SCE=+$PIECE($GET(^SCE(+$PIECE(SC0,U,8),0)),U,6)

 +12      ;Encounter IS a parent, so it's OK to process

                               IF 'SCE

                                   QUIT 

 +13      ;Check parents of children for validity

 +14                           SET SCE0=$GET(^SCE(SCE,0))

 +15      ;

 +16      ;'Estimate' processes Add/Edit data separate from 'parent' to avoid counting them twice, so the following checks are necessary to be sure the parent was a valid appt

 +17      ;Don't convert or add to estimate counts if children of an invalid appt

                               IF $PIECE(SCE0,U,8)=1

                                   SET X=$GET(^DPT(+$PIECE(SCE0,U,2),"S",+SCE0,0))

                                   IF $PIECE(X,U,2)'=""

                                       IF $PIECE(X,U,2)'="I"

                                           SET SCQUIT=1

                                           QUIT 

 +18      ;Don't convert or add to estimate counts if children of an invalid disposition

                               IF $PIECE(SCE0,U,8)=3

                                   SET X=$GET(^DPT(+$PIECE(SCE0,U,2),"DIS",9999999-SCE0,0))

                                   IF $PIECE(X,U,2)=2

                                       SET SCQUIT=1

                                       QUIT 

 +19      ; -- visit already exists / not historial visit 

                               IF $PIECE(SCE0,U,5)

                                   IF '$PIECE($GET(^SCE(SCE,"CNV")),U,4)

                                       SET SCQUIT=1

                                       QUIT 

 +20      ;Parent has no visit, don't convert children

                               IF SCCVEVT

                                   IF '$PIECE(SCE0,U,5)

                                       SET SCQUIT=1

 +21      ;

                           End DoDot:2

                           IF SCQUIT

                               QUIT 

 +22                   DO EN^SCCVEAE1(SCCVEVT,SCDTM,SCDA,0,SCLOG)

 +23                   IF $GET(SCLOG)

                           DO STOP^SCCVLOG(SCLOG,SCREQ,.SCSTOPF)

 +24                   IF '$GET(SCLOG)

                           SET SCTOT("OK")=1

                   End DoDot:1

STOPQ      QUIT 

 +1       ;

ZERO(SCDTM) ; -- fix zeroth if missing

 +1        IF '$DATA(^SDV(SCDTM,"CS",0))

               IF $ORDER(^SDV(SCDTM,"CS",0))

                   SET ^SDV(SCDTM,"CS",0)="^409.51P^^"

 +2        QUIT 

 +3       ;