- 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 Mar 13, 2025@21:43:38 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 ;
