SCCVEAE3.m

SCCVEAE3 ;ALB/RMO,TMP - Add/Edit Conversion cont.; [ 04/05/95  8:46 AM ]

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

 ;

SET(SCCVEVT,SCLOG,SCDTM,SCVALDT,SCDA,SCOEP,SCOE,SCCV) ; Set variables, add encounter/visit

 ; Input  -- SCCVEVT  Conversion event

 ;           SCLOG    Scheduling conversion log IEN

 ;           SCDTM    Visit date/time (IEN)

 ;           SCVALDT  Valid converted Visit date/time (SCDTM)

 ;           SCDA     Clinic stop code sub-file IEN

 ;           SCOEP    Parent outpatient encounter IEN [optional]

 ; Output -- SCOE     Outpatient encounter IEN

 ;           SCCV     Conversion array:

 ;                    SCCV("EVT")       Conversion event

 ;                        ("LOG")       Scheduling conversion log IEN

 ;                        ("NEW")       Outpatient encounter or visit

 ;                                       created by conversion flag

 ;                                       0 = no new encounter or visit

 ;                                       1 = new encounter and visit

 ;                                       2 = new visit only

 ;                        ("OE",0)      Outpatient encounter 0th node

 ;                        ("CS",0)      Clinic stop code 0th node

 ;                        ("CS",1)      Clinic stop code 1 node

 ;                        ("CS","PR")   Clinic stop code 'PR' node

 ;                        ("ERR")       Code for specific error, if any

 ;                        ("VST")       Visit file IEN

 ;

 N SCCVSIT,SCV0,DA,DR,DE,DQ,DIE,SDVSIT,SCOE0,SCCVT,X

 S SCCV("EVT")=SCCVEVT

 S SCCV("LOG")=SCLOG

 ;

 ; If estimating, increment the total number of encounters and visits

 ;  that would be created by the conversion

 ; If converting, create a new encounter and/or visit

 ;

 I '$G(^SDV(SCDTM,0)) S SCCV("ERR")=4 G SETQ

 S SCCVSIT=^SDV(SCDTM,0),SDVSIT("DFN")=$P(SCCVSIT,U,2)

 I 'SDVSIT("DFN") S SCCV("ERR")=5 G SETQ

 ;

 I '$D(^SDV(SCDTM,"CS",SCDA,0)) S SCCV("ERR")=9 G SETQ

 S SCV0=^SDV(SCDTM,"CS",SCDA,0),SCCV("CS","PR")=$G(^("PR"))

 ;

 S SCOE=+$P(SCV0,U,8),SCOE0=$G(^SCE(SCOE,0))

 ;

 ; On re-convert, delete previously converted data for parents only

 I SCCVEVT=2,'$P(SCOE0,U,6) D

 . ; only delete for reconvert if we created the encounter or completed

 . ;   the conversion by adding the visit

 . Q:'$$CCREATE^SCCVU(SCOE)

 . ;

 . D RECNVT^SCCVEAP3(SCOE,SCOE0,.SCCONS)

 . S SCOE0=$G(^SCE(SCOE,0)) S:SCOE0="" SCOE=0

 ;

 S SCCV("NEW")=$S('SCOE:1,'$P(SCOE0,U,5):2,1:0)

 ;

 I 'SCCV("NEW") G SETQ ; Already has an encounter and visit

 ;

 I 'SCCVEVT D  G SETQ ; Estimate exits here

 . ; -- don't incrment if child will use parent's visit ien

 . IF SCCV("NEW")=2,$G(SCOEP),$D(^SCE(SCOEP,0)),$P(^(0),U,3)=$P(SCOE0,U,3),$P(^(0),U,4)=$P(SCOE0,U,4) Q

 . D INCRTOT^SCCVEGU1(.SCTOT,SCCV("NEW")+6,1)

 . D EN^SCCVZZ("AE-"_(SCCV("NEW")+6),SCOE,SCDTM,SCDA,$S(SCOEP:SCOEP,$P($G(^SCE(SCOE,0)),U,6):+$P(^(0),U,6),1:0),SDVSIT("DFN"))

 ;

 S SDVSIT("DIV")=+$P($G(^SC(+$P(SCV0,U,3),0)),U,15)

 S:'SDVSIT("DIV") SDVSIT("DIV")=+$P(SCCVSIT,U,3)

 S SDVSIT("DIV")=$$DIV(SDVSIT("DIV"))

 I 'SDVSIT("DIV") S SCCV("ERR")=6 G SETQ

 ;

 S SDVSIT("CLN")=+SCV0

 I $P($G(^DIC(40.7,+SCV0,0)),U,2)=900 S SDVSIT("CLN")=+$P($G(^SC(+$P(SCV0,U,3),0)),U,7)

 I 'SDVSIT("CLN") S SCCV("ERR")=7 G SETQ

 ;

 S:$P(SCV0,U,3) SDVSIT("LOC")=$P(SCV0,U,3)

 S:$P(SCV0,U,4) SDVSIT("ELG")=$P(SCV0,U,4)

 S:$P(SCV0,U,5) SDVSIT("TYP")=$P(SCV0,U,5)

 S SDVSIT("ORG")=2,SDVSIT("REF")=SCDA

 D SETSCCVT^SCCVEAP2(.SCCVT,.SCCONS)

 ;

 S:$G(SCOEP) SDVSIT("PAR")=SCOEP

 ;

 I SCCV("NEW")=2 D  G:'$G(SDVSIT("VST")) SETQ ; -- Has encounter, needs visit

 . S SCOE=$P(SCV0,U,8),SDVSIT("OE",0)=SCOE0

 . S SDVSIT("OE")=SCOE

 . S X=$$VISIT^SCCVEAP2(SCVALDT,.SDVSIT) ; -- Add visit only

 . S SCOE0=SDVSIT("OE",0)

 ;

 I SCCV("NEW")=1 D  ; -- Needs both encounter and visit added

 .S SCOE=$$SDOE^SDVSIT(SCVALDT,.SDVSIT),SCOE0=$G(^SCE(+SCOE,0))

 .S:SCOE SCTOT(1.02)=$G(SCTOT(1.02))+1

 ;

 G SETQ:'SCOE

 ;

 I $G(SDVSIT("VST")),'$P(SCOE0,U,5) S SCDATA(.05)=SDVSIT("VST") D UPD^SCCVDBU(409.68,SCOE,.SCDATA) K SCDATA

 ;

 ; Update 'CS' node with encounter pointer

 I SCCV("NEW")=1 S SCDATA(8)=SCOE,SCIENS=SCDA_","_SCDTM D UPD^SCCVDBU(409.51,SCIENS,.SCDATA) K SCDATA

 ;

 M SCCV=SDVSIT

 S SCCV("OE",0)=$G(^SCE(SCOE,0))

 S SCCV("VST")=$P($G(SCCV("OE",0)),U,5)

 S SCCV("CS",0)=$G(^SDV(SCDTM,"CS",SCDA,0)),SCCV("CS",1)=$G(^(1))

 ;

 IF SCCV("NEW")=1 D CSCAN(SCDTM,.SCCV)

 ;

SETQ Q

 ;

DIV(DIV) ; -- determine med div

 I $P($G(^DG(43,1,"GL")),U,2),$D(^DG(40.8,+DIV,0)) G DIVQ ; multi-div?

 S DIV=+$O(^DG(40.8,0))

DIVQ Q DIV

 ;

CSCAN(SCDTM,SCCV) ; -- update 900 "CS" nodes with same clinic

 N SCLN,SCS,SCS0,SCNT,SCEXT

 S SCLN=+$P($G(SCCV("CS",0)),U,3)

 S SCOE=+$P($G(SCCV("CS",0)),U,8)

 S SCEXT=$P(SCCV("OE",0),U,9)

 ;

 IF 'SCCV900!('SCLN)!('SCOE)!(SCEXT="") G CSCANQ

 ;

 S SCNT=0

 ; -- scan for "CS" nodes that are 900's, same clinic & no encounter

 S SCS=0 F  S SCS=$O(^SDV(SCDTM,"CS",SCS)) Q:'SCS  S SCS0=$G(^(SCS,0)) D

 . IF +SCS0=SCCV900,+$P(SCS0,U,3)=SCLN,'$P(SCS0,U,8) D

 . . N SCDATA,SCIENS

 . . S SCDATA(8)=SCOE ; -- set sce ien

 . . S SCDATA(9)=1    ; -- mark converted

 . . S SCIENS=SCS_","_SCDTM

 . . D UPD^SCCVDBU(409.51,SCIENS,.SCDATA)

 . . S SCEXT=SCEXT_":"_SCS

 . . S SCNT=SCNT+1

 ;

 IF 'SCNT G CSCANQ

 ;

 N SCDATA

 S SCDATA(.09)=SCEXT D UPD^SCCVDBU(409.68,SCOE,.SCDATA)

 S SCCV("OE",0)=$G(^SCE(SCOE,0))

 ;

CSCANQ Q

 ;

SCCVEAE3  ;ALB/RMO,TMP - Add/Edit Conversion cont.; [ 04/05/95  8:46 AM ]

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

 +2       ;

SET(SCCVEVT,SCLOG,SCDTM,SCVALDT,SCDA,SCOEP,SCOE,SCCV) ; Set variables, add encounter/visit

 +1       ; Input  -- SCCVEVT  Conversion event

 +2       ;           SCLOG    Scheduling conversion log IEN

 +3       ;           SCDTM    Visit date/time (IEN)

 +4       ;           SCVALDT  Valid converted Visit date/time (SCDTM)

 +5       ;           SCDA     Clinic stop code sub-file IEN

 +6       ;           SCOEP    Parent outpatient encounter IEN [optional]

 +7       ; Output -- SCOE     Outpatient encounter IEN

 +8       ;           SCCV     Conversion array:

 +9       ;                    SCCV("EVT")       Conversion event

 +10      ;                        ("LOG")       Scheduling conversion log IEN

 +11      ;                        ("NEW")       Outpatient encounter or visit

 +12      ;                                       created by conversion flag

 +13      ;                                       0 = no new encounter or visit

 +14      ;                                       1 = new encounter and visit

 +15      ;                                       2 = new visit only

 +16      ;                        ("OE",0)      Outpatient encounter 0th node

 +17      ;                        ("CS",0)      Clinic stop code 0th node

 +18      ;                        ("CS",1)      Clinic stop code 1 node

 +19      ;                        ("CS","PR")   Clinic stop code 'PR' node

 +20      ;                        ("ERR")       Code for specific error, if any

 +21      ;                        ("VST")       Visit file IEN

 +22      ;

 +23       NEW SCCVSIT,SCV0,DA,DR,DE,DQ,DIE,SDVSIT,SCOE0,SCCVT,X

 +24       SET SCCV("EVT")=SCCVEVT

 +25       SET SCCV("LOG")=SCLOG

 +26      ;

 +27      ; If estimating, increment the total number of encounters and visits

 +28      ;  that would be created by the conversion

 +29      ; If converting, create a new encounter and/or visit

 +30      ;

 +31       IF '$GET(^SDV(SCDTM,0))

               SET SCCV("ERR")=4

               GOTO SETQ

 +32       SET SCCVSIT=^SDV(SCDTM,0)

           SET SDVSIT("DFN")=$PIECE(SCCVSIT,U,2)

 +33       IF 'SDVSIT("DFN")

               SET SCCV("ERR")=5

               GOTO SETQ

 +34      ;

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

               SET SCCV("ERR")=9

               GOTO SETQ

 +36       SET SCV0=^SDV(SCDTM,"CS",SCDA,0)

           SET SCCV("CS","PR")=$GET(^("PR"))

 +37      ;

 +38       SET SCOE=+$PIECE(SCV0,U,8)

           SET SCOE0=$GET(^SCE(SCOE,0))

 +39      ;

 +40      ; On re-convert, delete previously converted data for parents only

 +41       IF SCCVEVT=2

               IF '$PIECE(SCOE0,U,6)

                   Begin DoDot:1

 +42      ; only delete for reconvert if we created the encounter or completed

 +43      ;   the conversion by adding the visit

 +44                   IF '$$CCREATE^SCCVU(SCOE)

                           QUIT 

 +45      ;

 +46                   DO RECNVT^SCCVEAP3(SCOE,SCOE0,.SCCONS)

 +47                   SET SCOE0=$GET(^SCE(SCOE,0))

                       IF SCOE0=""

                           SET SCOE=0

                   End DoDot:1

 +48      ;

 +49       SET SCCV("NEW")=$SELECT('SCOE:1,'$PIECE(SCOE0,U,5):2,1:0)

 +50      ;

 +51      ; Already has an encounter and visit

           IF 'SCCV("NEW")

               GOTO SETQ

 +52      ;

 +53      ; Estimate exits here

           IF 'SCCVEVT

               Begin DoDot:1

 +54      ; -- don't incrment if child will use parent's visit ien

 +55               IF SCCV("NEW")=2

                       IF $GET(SCOEP)

                           IF $DATA(^SCE(SCOEP,0))

                               IF $PIECE(^(0),U,3)=$PIECE(SCOE0,U,3)

                                   IF $PIECE(^(0),U,4)=$PIECE(SCOE0,U,4)

                                       QUIT 

 +56               DO INCRTOT^SCCVEGU1(.SCTOT,SCCV("NEW")+6,1)

 +57               DO EN^SCCVZZ("AE-"_(SCCV("NEW")+6),SCOE,SCDTM,SCDA,$SELECT(SCOEP:SCOEP,$PIECE($GET(^SCE(SCOE,0)),U,6):+$PIECE(^(0),U,6),1:0),SDVSIT("DFN"))

               End DoDot:1

               GOTO SETQ

 +58      ;

 +59       SET SDVSIT("DIV")=+$PIECE($GET(^SC(+$PIECE(SCV0,U,3),0)),U,15)

 +60       IF 'SDVSIT("DIV")

               SET SDVSIT("DIV")=+$PIECE(SCCVSIT,U,3)

 +61       SET SDVSIT("DIV")=$$DIV(SDVSIT("DIV"))

 +62       IF 'SDVSIT("DIV")

               SET SCCV("ERR")=6

               GOTO SETQ

 +63      ;

 +64       SET SDVSIT("CLN")=+SCV0

 +65       IF $PIECE($GET(^DIC(40.7,+SCV0,0)),U,2)=900

               SET SDVSIT("CLN")=+$PIECE($GET(^SC(+$PIECE(SCV0,U,3),0)),U,7)

 +66       IF 'SDVSIT("CLN")

               SET SCCV("ERR")=7

               GOTO SETQ

 +67      ;

 +68       IF $PIECE(SCV0,U,3)

               SET SDVSIT("LOC")=$PIECE(SCV0,U,3)

 +69       IF $PIECE(SCV0,U,4)

               SET SDVSIT("ELG")=$PIECE(SCV0,U,4)

 +70       IF $PIECE(SCV0,U,5)

               SET SDVSIT("TYP")=$PIECE(SCV0,U,5)

 +71       SET SDVSIT("ORG")=2

           SET SDVSIT("REF")=SCDA

 +72       DO SETSCCVT^SCCVEAP2(.SCCVT,.SCCONS)

 +73      ;

 +74       IF $GET(SCOEP)

               SET SDVSIT("PAR")=SCOEP

 +75      ;

 +76      ; -- Has encounter, needs visit

           IF SCCV("NEW")=2

               Begin DoDot:1

 +77               SET SCOE=$PIECE(SCV0,U,8)

                   SET SDVSIT("OE",0)=SCOE0

 +78               SET SDVSIT("OE")=SCOE

 +79      ; -- Add visit only

                   SET X=$$VISIT^SCCVEAP2(SCVALDT,.SDVSIT)

 +80               SET SCOE0=SDVSIT("OE",0)

               End DoDot:1

               IF '$GET(SDVSIT("VST"))

                   GOTO SETQ

 +81      ;

 +82      ; -- Needs both encounter and visit added

           IF SCCV("NEW")=1

               Begin DoDot:1

 +83               SET SCOE=$$SDOE^SDVSIT(SCVALDT,.SDVSIT)

                   SET SCOE0=$GET(^SCE(+SCOE,0))

 +84               IF SCOE

                       SET SCTOT(1.02)=$GET(SCTOT(1.02))+1

               End DoDot:1

 +85      ;

 +86       IF 'SCOE

               GOTO SETQ

 +87      ;

 +88       IF $GET(SDVSIT("VST"))

               IF '$PIECE(SCOE0,U,5)

                   SET SCDATA(.05)=SDVSIT("VST")

                   DO UPD^SCCVDBU(409.68,SCOE,.SCDATA)

                   KILL SCDATA

 +89      ;

 +90      ; Update 'CS' node with encounter pointer

 +91       IF SCCV("NEW")=1

               SET SCDATA(8)=SCOE

               SET SCIENS=SCDA_","_SCDTM

               DO UPD^SCCVDBU(409.51,SCIENS,.SCDATA)

               KILL SCDATA

 +92      ;

 +93       MERGE SCCV=SDVSIT

 +94       SET SCCV("OE",0)=$GET(^SCE(SCOE,0))

 +95       SET SCCV("VST")=$PIECE($GET(SCCV("OE",0)),U,5)

 +96       SET SCCV("CS",0)=$GET(^SDV(SCDTM,"CS",SCDA,0))

           SET SCCV("CS",1)=$GET(^(1))

 +97      ;

 +98       IF SCCV("NEW")=1

               DO CSCAN(SCDTM,.SCCV)

 +99      ;

SETQ       QUIT 

 +1       ;

DIV(DIV)  ; -- determine med div

 +1       ; multi-div?

           IF $PIECE($GET(^DG(43,1,"GL")),U,2)

               IF $DATA(^DG(40.8,+DIV,0))

                   GOTO DIVQ

 +2        SET DIV=+$ORDER(^DG(40.8,0))

DIVQ       QUIT DIV

 +1       ;

CSCAN(SCDTM,SCCV) ; -- update 900 "CS" nodes with same clinic

 +1        NEW SCLN,SCS,SCS0,SCNT,SCEXT

 +2        SET SCLN=+$PIECE($GET(SCCV("CS",0)),U,3)

 +3        SET SCOE=+$PIECE($GET(SCCV("CS",0)),U,8)

 +4        SET SCEXT=$PIECE(SCCV("OE",0),U,9)

 +5       ;

 +6        IF 'SCCV900!('SCLN)!('SCOE)!(SCEXT="")

               GOTO CSCANQ

 +7       ;

 +8        SET SCNT=0

 +9       ; -- scan for "CS" nodes that are 900's, same clinic & no encounter

 +10       SET SCS=0

           FOR 

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

               IF 'SCS

                   QUIT 

               SET SCS0=$GET(^(SCS,0))

               Begin DoDot:1

 +11               IF +SCS0=SCCV900

                       IF +$PIECE(SCS0,U,3)=SCLN

                           IF '$PIECE(SCS0,U,8)

                               Begin DoDot:2

 +12                               NEW SCDATA,SCIENS

 +13      ; -- set sce ien

                                   SET SCDATA(8)=SCOE

 +14      ; -- mark converted

                                   SET SCDATA(9)=1

 +15                               SET SCIENS=SCS_","_SCDTM

 +16                               DO UPD^SCCVDBU(409.51,SCIENS,.SCDATA)

 +17                               SET SCEXT=SCEXT_":"_SCS

 +18                               SET SCNT=SCNT+1

                               End DoDot:2

               End DoDot:1

 +19      ;

 +20       IF 'SCNT

               GOTO CSCANQ

 +21      ;

 +22       NEW SCDATA

 +23       SET SCDATA(.09)=SCEXT

           DO UPD^SCCVDBU(409.68,SCOE,.SCDATA)

 +24       SET SCCV("OE",0)=$GET(^SCE(SCOE,0))

 +25      ;

CSCANQ     QUIT 

 +1       ;