SCCVEAP4.m

SCCVEAP4 ;ALB/RMO,TMP - Appointment Conversion cont.; [ 04/05/95  10:19 AM ]

 ;;5.3;Scheduling;**211**;Aug 13, 1993

 ;

CREDIT(SCOE,SCDTM,SCCV,SCCVEVT) ; Add/delete visit for credit stop

 ;  (for add encounter and visit - ^SDVSIT does it)

 ;Input:

 ;           SCOE     Parent encounter ien

 ;           SCDTM    Appointment date/time

 ;           SCCV     Conversion array

 ;           SCCVEVT  Conversion event (0/1/2)

 N SCCRST,SCOE00,SCOEC,SCHIST,SCOESV,SCCVX,SCVSIT,SCQ,SCX,X

 ; Credit stop code may need a visit, too

 ; Find 'child' clinic stop code encounter, if there

 S (SCHIST,SCOEC,SCQ,SCX)=0,SCOE00=""

 F  S SCOEC=$O(^SCE("APAR",SCOE,SCOEC)) Q:'SCOEC  D  Q:SCQ

 . S SCOE00=$G(^SCE(SCOEC,0))

 . I $P(SCOE00,U,8)=4 S SCHIST=+$P($G(^SCE(SCOEC,"CNV")),U,3),SCQ=1 Q

 . I 'SCX,$P(SCOE00,U,8)=2,$P(SCOE00,U,9),+$G(^SDV($$SDVIEN^SCCVU(+$P(SCOE00,U,2),SCDTM),"CS",+$P(SCOE00,U,9),0))=$P(SCCV("CL1",0),U,18) S SCX=SCOEC

 ;

 I SCOE,'SCOEC G CREDITQ ;Appt enc exists, so credit enc should have

 ;                        existed if valid at time of appt enc creation

 I 'SCOEC D

 . I SCX S SCOEC=SCX Q

 . S SCHIST=1

 ;

 I $P($G(^SCE(+SCOEC,0)),U,5) G CREDITQ ; Already has visit

 ;

 I SCHIST,$P(SCCV("CL1",0),U,17)="Y" G CREDITQ ; non-count clinic

 ;

 S SCCRST=$S('SCHIST:$P(SCOE00,U,3),1:$P($G(SCCV("CL1",0)),U,18))

 ;

 G:'SCCRST CREDITQ ; no credit stop code assigned to this appt

 IF SCHIST,SCCRST=$P(SCCV("CL1",0),U,7) G CREDITQ ; credit stop code same as stop code for this clinic

 ;

 I SCHIST S SCQ=0 D  G:SCQ CREDITQ

 . S X=$P($G(^DIC(40.7,SCCRST,0)),U,3)

 . I $S('X:0,1:(SCDTM\1)'<X) S SCQ=1 ; stop code was inactive

 ;

 I 'SCCVEVT D  Q  ;estimate exits here

 .N ZZZ

 .S ZZZ=$S(SCOEC:SCOEC,1:0)

 .D INCRTOT^SCCVEGU1(.SCTOT,8-SCHIST,1),INCRTOT^SCCVEGU1(.SCTOT,4,1),EN^SCCVZZ("CREDIT-"_(8-SCHIST),ZZZ,SCDTM,$P($G(SCCV("PT",0)),U),SCOE),EN^SCCVZZ("CREDIT-4",ZZZ,SCDTM,$P($G(SCCV("PT",0)),U),SCOE)

 ;

 I SCCVEVT=2,SCOEC,$P(SCOE00,U,5) D

 . D RECNVT^SCCVEAP3(SCOEC,SCOE00,.SCCONS) ;Re-converting - delete old visit/enctr

 . I '$D(^SCE(SCOEC,0)) S SCHIST=1

 ;

 ;If historical, we need to add both the encounter and the visit

 I SCHIST D  G CREDITQ

 . N SCOEX,SCCVT

 . S SCVSIT("DFN")=$P(SCCV("OE",0),U,2)

 . S SCVSIT("CLN")=SCCRST

 . S SCVSIT("DIV")=$P(SCCV("OE",0),U,11)

 . S SCVSIT("ELG")=$P(SCCV("OE",0),U,13)

 . S SCVSIT("LOC")=$P(SCCV("PT",0),U)

 . S SCVSIT("TYP")=$P(SCCV("OE",0),U,10)

 . S SCVSIT("PAR")=SCOE

 . S SCVSIT("ORG")=4,SCVSIT("REF")=0

 . D SETSCCVT^SCCVEAP2(.SCCVT,.SCCONS)

 . S SCOEX=$$SDOE^SDVSIT(SCDTM,.SCVSIT,"",SCVSIT("PAR"))

 . ;

 . I SCOEX D

 .. N SCCVX

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

 .. S SCCVX("HIST")=1,SCCVX("NEW")=1

 .. D ENC^SCCVEAP1(SCOEX,.SCCVX)

 . ;

 . I 'SCOEX!'$G(SCVSIT("VST")) D  ;Encounter or visit not created

 .. D CREATERR^SCCVLOG1(SCVSIT("DFN"),SCDTM,+SCOEX,4,SCVSIT("LOC"),SCCRST,$G(SCLOG))

 .. S:SCOEX ^XTMP("SCCV-ERR-"_+SCLOG,"NO-VIS",SCOEX)=""

 .. S SCTOT(2.06)=$G(SCTOT(2.06))+1

 ;

 ;Add visit only if encounter, but no visit exists

 G:$P($G(^SCE(SCOEC,0)),U,5) CREDITQ

 ;

 M SCVSIT=SCCV

 S SCVSIT("OE")=SCOEC

 S SCVSIT("OE",0)=$G(^SCE(SCOEC,0))

 S SCVSIT("CSC")=SCCRST,SCVSIT("PAR")=SCOE,SCVSIT("ORG")=4

 S SCVSIT("VST")=$$VISIT^SCCVEAP2(SCDTM,.SCVSIT) ; create visit

 ;

 I 'SCVSIT("VST") D  ;No visit

 . D CREATERR^SCCVLOG1(+$P($G(SCVSIT("OE",0)),U,2),SCDTM,+SCOEC,4,$P($G(SCCV("PT",0)),U),SCCRST,$G(SCLOG))

 . S ^XTMP("SCCV-ERR-"_+SCLOG,"NO-VIS",SCOEC)=""

 . S SCTOT(2.06)=$G(SCTOT(2.06))+1

 ;

 I SCVSIT("VST") S SCCVX("VST")=SCCV("VST") D ENC^SCCVEAP1(SCOEC,.SCCVX)

 ;

CREDITQ Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SCCVEAP4   3630     printed  Mar 13, 2025@21:43:43                                                                                                                                                                                                    Page 2

SCCVEAP4  ;ALB/RMO,TMP - Appointment Conversion cont.; [ 04/05/95  10:19 AM ]

 +1       ;;5.3;Scheduling;**211**;Aug 13, 1993

 +2       ;

CREDIT(SCOE,SCDTM,SCCV,SCCVEVT) ; Add/delete visit for credit stop

 +1       ;  (for add encounter and visit - ^SDVSIT does it)

 +2       ;Input:

 +3       ;           SCOE     Parent encounter ien

 +4       ;           SCDTM    Appointment date/time

 +5       ;           SCCV     Conversion array

 +6       ;           SCCVEVT  Conversion event (0/1/2)

 +7        NEW SCCRST,SCOE00,SCOEC,SCHIST,SCOESV,SCCVX,SCVSIT,SCQ,SCX,X

 +8       ; Credit stop code may need a visit, too

 +9       ; Find 'child' clinic stop code encounter, if there

 +10       SET (SCHIST,SCOEC,SCQ,SCX)=0

           SET SCOE00=""

 +11       FOR 

               SET SCOEC=$ORDER(^SCE("APAR",SCOE,SCOEC))

               if 'SCOEC

                   QUIT 

               Begin DoDot:1

 +12               SET SCOE00=$GET(^SCE(SCOEC,0))

 +13               IF $PIECE(SCOE00,U,8)=4

                       SET SCHIST=+$PIECE($GET(^SCE(SCOEC,"CNV")),U,3)

                       SET SCQ=1

                       QUIT 

 +14               IF 'SCX

                       IF $PIECE(SCOE00,U,8)=2

                           IF $PIECE(SCOE00,U,9)

                               IF +$GET(^SDV($$SDVIEN^SCCVU(+$PIECE(SCOE00,U,2),SCDTM),"CS",+$PIECE(SCOE00,U,9),0))=$PIECE(SCCV("CL1",0),U,18)

                                   SET SCX=SCOEC

               End DoDot:1

               if SCQ

                   QUIT 

 +15      ;

 +16      ;Appt enc exists, so credit enc should have

           IF SCOE

               IF 'SCOEC

                   GOTO CREDITQ

 +17      ;                        existed if valid at time of appt enc creation

 +18       IF 'SCOEC

               Begin DoDot:1

 +19               IF SCX

                       SET SCOEC=SCX

                       QUIT 

 +20               SET SCHIST=1

               End DoDot:1

 +21      ;

 +22      ; Already has visit

           IF $PIECE($GET(^SCE(+SCOEC,0)),U,5)

               GOTO CREDITQ

 +23      ;

 +24      ; non-count clinic

           IF SCHIST

               IF $PIECE(SCCV("CL1",0),U,17)="Y"

                   GOTO CREDITQ

 +25      ;

 +26       SET SCCRST=$SELECT('SCHIST:$PIECE(SCOE00,U,3),1:$PIECE($GET(SCCV("CL1",0)),U,18))

 +27      ;

 +28      ; no credit stop code assigned to this appt

           if 'SCCRST

               GOTO CREDITQ

 +29      ; credit stop code same as stop code for this clinic

           IF SCHIST

               IF SCCRST=$PIECE(SCCV("CL1",0),U,7)

                   GOTO CREDITQ

 +30      ;

 +31       IF SCHIST

               SET SCQ=0

               Begin DoDot:1

 +32               SET X=$PIECE($GET(^DIC(40.7,SCCRST,0)),U,3)

 +33      ; stop code was inactive

                   IF $SELECT('X:0,1:(SCDTM\1)'<X)

                       SET SCQ=1

               End DoDot:1

               if SCQ

                   GOTO CREDITQ

 +34      ;

 +35      ;estimate exits here

           IF 'SCCVEVT

               Begin DoDot:1

 +36               NEW ZZZ

 +37               SET ZZZ=$SELECT(SCOEC:SCOEC,1:0)

 +38               DO INCRTOT^SCCVEGU1(.SCTOT,8-SCHIST,1)

                   DO INCRTOT^SCCVEGU1(.SCTOT,4,1)

                   DO EN^SCCVZZ("CREDIT-"_(8-SCHIST),ZZZ,SCDTM,$PIECE($GET(SCCV("PT",0)),U),SCOE)

                   DO EN^SCCVZZ("CREDIT-4",ZZZ,SCDTM,$PIECE($GET(SCCV("PT",0)),U),SCOE)

               End DoDot:1

               QUIT 

 +39      ;

 +40       IF SCCVEVT=2

               IF SCOEC

                   IF $PIECE(SCOE00,U,5)

                       Begin DoDot:1

 +41      ;Re-converting - delete old visit/enctr

                           DO RECNVT^SCCVEAP3(SCOEC,SCOE00,.SCCONS)

 +42                       IF '$DATA(^SCE(SCOEC,0))

                               SET SCHIST=1

                       End DoDot:1

 +43      ;

 +44      ;If historical, we need to add both the encounter and the visit

 +45       IF SCHIST

               Begin DoDot:1

 +46               NEW SCOEX,SCCVT

 +47               SET SCVSIT("DFN")=$PIECE(SCCV("OE",0),U,2)

 +48               SET SCVSIT("CLN")=SCCRST

 +49               SET SCVSIT("DIV")=$PIECE(SCCV("OE",0),U,11)

 +50               SET SCVSIT("ELG")=$PIECE(SCCV("OE",0),U,13)

 +51               SET SCVSIT("LOC")=$PIECE(SCCV("PT",0),U)

 +52               SET SCVSIT("TYP")=$PIECE(SCCV("OE",0),U,10)

 +53               SET SCVSIT("PAR")=SCOE

 +54               SET SCVSIT("ORG")=4

                   SET SCVSIT("REF")=0

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

 +56               SET SCOEX=$$SDOE^SDVSIT(SCDTM,.SCVSIT,"",SCVSIT("PAR"))

 +57      ;

 +58               IF SCOEX

                       Begin DoDot:2

 +59                       NEW SCCVX

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

 +61                       SET SCCVX("HIST")=1

                           SET SCCVX("NEW")=1

 +62                       DO ENC^SCCVEAP1(SCOEX,.SCCVX)

                       End DoDot:2

 +63      ;

 +64      ;Encounter or visit not created

                   IF 'SCOEX!'$GET(SCVSIT("VST"))

                       Begin DoDot:2

 +65                       DO CREATERR^SCCVLOG1(SCVSIT("DFN"),SCDTM,+SCOEX,4,SCVSIT("LOC"),SCCRST,$GET(SCLOG))

 +66                       if SCOEX

                               SET ^XTMP("SCCV-ERR-"_+SCLOG,"NO-VIS",SCOEX)=""

 +67                       SET SCTOT(2.06)=$GET(SCTOT(2.06))+1

                       End DoDot:2

               End DoDot:1

               GOTO CREDITQ

 +68      ;

 +69      ;Add visit only if encounter, but no visit exists

 +70       if $PIECE($GET(^SCE(SCOEC,0)),U,5)

               GOTO CREDITQ

 +71      ;

 +72       MERGE SCVSIT=SCCV

 +73       SET SCVSIT("OE")=SCOEC

 +74       SET SCVSIT("OE",0)=$GET(^SCE(SCOEC,0))

 +75       SET SCVSIT("CSC")=SCCRST

           SET SCVSIT("PAR")=SCOE

           SET SCVSIT("ORG")=4

 +76      ; create visit

           SET SCVSIT("VST")=$$VISIT^SCCVEAP2(SCDTM,.SCVSIT)

 +77      ;

 +78      ;No visit

           IF 'SCVSIT("VST")

               Begin DoDot:1

 +79               DO CREATERR^SCCVLOG1(+$PIECE($GET(SCVSIT("OE",0)),U,2),SCDTM,+SCOEC,4,$PIECE($GET(SCCV("PT",0)),U),SCCRST,$GET(SCLOG))

 +80               SET ^XTMP("SCCV-ERR-"_+SCLOG,"NO-VIS",SCOEC)=""

 +81               SET SCTOT(2.06)=$GET(SCTOT(2.06))+1

               End DoDot:1

 +82      ;

 +83       IF SCVSIT("VST")

               SET SCCVX("VST")=SCCV("VST")

               DO ENC^SCCVEAP1(SCOEC,.SCCVX)

 +84      ;

CREDITQ    QUIT 

 +1       ;