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 ---[H[J[2J[HSCCVEAP4 3630 printed Apr 09, 2024@21:51:34 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 ;
