SCCVEAE3 ;ALB/RMO,TMP - Add/Edit Conversion cont.; [ 04/05/95 8:46 AM ]
;;5.3;Scheduling;**211**;Aug 13, 1993
;
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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCCVEAE3 5438 printed Apr 09, 2024@21:41:20 Page 2
SCCVEAE3 ;ALB/RMO,TMP - Add/Edit Conversion cont.; [ 04/05/95 8:46 AM ]
+1 ;;5.3;Scheduling;**211**;Aug 13, 1993
+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 ;
