SCCVEAP3 ;ALB/RMO,TMP - Appointment Conversion cont.; [ 04/05/95 10:19 AM ]
;;5.3;Scheduling;**211**;Aug 13, 1993
;
SET(SCCVEVT,SCLOG,DFN,SCDTM,SCCLN,SCDA,SCOE,SCCV) ; Set variables
; Input -- SCCVEVT Conversion event
; SCLOG Scheduling conversion log IEN
; DFN Patient IEN
; SCDTM Appointment date/time
; SCCLN Clinic IEN
; Output -- SCDA Clinic appt patient sub-file IEN
; SCOE Outpatient encounter IEN
; SCCV Conversion array:
; SCCV("EVT") Conversion event
; ("LOG") Scheduling conversion log IEN
; ("NEW") Outpatient encounter
; created by conversion flag
; 0 = no new encounter or visit
; 1 = new encounter and visit
; 2 = new visit only
; ("SCDA") Multiple entry in ^SC for this pt
; ("OE",0) Outpatient encounter 0th node
; ("PT",0) Patient appt 0th node
; ("PT","R") Patient appt "R" node (Remarks)
; ("CL1",0) Clinic's 0th node
; ("CL",0) Clinic appt patient 0th node
; ("CL","C") Clinic appt patient "C" node (Check in/out)
; ("ERR") Code for specific error, if any
; ("VST") Visit file IEN
;
N SCOE0,SCDATA,SCIENS
;
S:'$G(SCDA) SCDA=+$$FIND^SDAM2(DFN,SCDTM,SCCLN) ; Find multiple entry in ^SC for this pt
;
S SCOE=+$P($G(^DPT(DFN,"S",SCDTM,0)),U,20),SCOE0=$G(^SCE(SCOE,0))
;
; -- following is commented out ; left for reference purposes
; -- this 'if' should always fail ; CON^SCCVEAP1 has this covered
;IF 'SCOE,'SCDA S SCCV("ERR")=1 G SETQ
;
S SCCV("SCDA")=SCDA
S SCCV("EVT")=SCCVEVT
;
S SCCV("LOG")=SCLOG
S SCCV("PT",0)=$G(^DPT(DFN,"S",SCDTM,0)),SCCV("PT","R")=$G(^("R"))
S SCCV("CL",0)=$G(^SC(SCCLN,"S",SCDTM,1,SCDA,0)),SCCV("CL","C")=$G(^("C"))
S SCCV("CL1",0)=$G(^SC(SCCLN,0))
;
; On re-convert, delete previously converted data
I SCCVEVT=2 D
. N SCDATA
. ; only delete for reconvert if we created the encounter or completed
. ; the conversion by adding the visit
. Q:'$$CCREATE^SCCVU(SCOE)
. ;
. S SCCV("OE",0)=SCOE0
. D RECNVT(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)
;
G:'SCCV("NEW") SETQ ; Already has both an encounter and visit
;
; Increment total number of encounters/visits that would be created by
; conversion (if estimating)
I 'SCCVEVT D G SETQ ; -- Estimate exits here
. D INCRTOT^SCCVEGU1(.SCTOT,SCCV("NEW")+6,1)
. D EN^SCCVZZ("APPT-"_(SCCV("NEW")+6),SCOE,SCDTM,$P($G(SCCV("PT",0)),U),+$P(SCOE0,U,6))
. D CREDIT^SCCVEAP4(SCOE,SCDTM,.SCCV,0)
;
I 'SCOE D ; Create enctr/visit
. N SCCVT
. D SETSCCVT^SCCVEAP2(.SCCVT,.SCCONS)
. IF 'SCDA F L +^SC(SCCLN,"S",SCDTM,1,999999):5 IF $T S ^SC(SCCLN,"S",SCDTM,1,999999,0)=DFN Q
. S SCOE=$$GETAPT^SDVSIT2(DFN,SCDTM,SCCLN,"")
. IF 'SCDA K ^SC(SCCLN,"S",SCDTM,1,999999) L -^SC(SCCLN,"S",SCDTM,1,999999)
. Q:'SCOE
. I $P($G(^SCE(SCOE,0)),U,3) S SCCV("HIST")=1
. S SCTOT(1.02)=$G(SCTOT(1.02))+1
;
S SCCV("OE")=+SCOE
S SCCV("OE",0)=$G(^SCE(+SCOE,0))
S SCCV("VST")=$P(SCCV("OE",0),U,5)
S SCCV("ORG")=1,SCCV("REF")=SCDA
;
I 'SCCV("VST"),SCOE,SCCV("NEW")'=1 D
. S SCCV("VST")=$$VISIT^SCCVEAP2(SCDTM,.SCCV) ; create visit if encounter already exists, but no visit
. D CREDIT^SCCVEAP4(SCOE,SCDTM,.SCCV,SCCVEVT)
;
SETQ Q
;
RECNVT(SCOE,SCOE0,SCCONS) ;Delete data added by conversion
;
N Z,SCVST,SCENC,SCENC0,SCCHLD,PXKNOEVT
;
S PXKNOEVT=1 ;Don't want event driver to fire off
;
S SCVST(0,SCOE,+$P(SCOE0,U,5))=+$G(^SCE(SCOE,"CNV")) ;Parent
D DELPTR(SCOE)
;
S SCENC=0 F S SCENC=$O(^SCE("APAR",SCOE,SCENC)) Q:'SCENC D
. S SCVST(1,SCENC,+$P($G(^SCE(SCENC,0)),U,5))=+$G(^SCE(SCENC,"CNV"))
. D DELPTR(SCENC)
;
S SCCHLD="" F S SCCHLD=$O(SCVST(SCCHLD)) Q:SCCHLD="" S SCENC=0 F S SCENC=$O(SCVST(SCCHLD,SCENC)) Q:'SCENC S SCVST="" F S SCVST=$O(SCVST(SCCHLD,SCENC,SCVST)) Q:SCVST="" D
. I SCVST(SCCHLD,SCENC,SCVST),$D(^SCE(SCENC,0)) D DELE^SCCVCST2(SCENC) ;Created by conversion - delete enctr
. Q:'SCVST!SCCHLD ;No need to delete children visits - they should go away w/parent
. S Z=$$DELVFILE^PXAPI("ALL",SCVST,$G(SCCONS("PKG")),$G(SCCONS("SRCE")))
Q
;
DELPTR(SCE) ; Delete visit pointer if encounter still exists
; SCE = encounter IEN
N SCDATA
I $P($G(^SCE(SCE,0)),U,5) S SCDATA(.05)="@" D UPD^SCCVDBU(409.68,SCE,.SCDATA)
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCCVEAP3 4865 printed Dec 13, 2024@02:38:46 Page 2
SCCVEAP3 ;ALB/RMO,TMP - Appointment Conversion cont.; [ 04/05/95 10:19 AM ]
+1 ;;5.3;Scheduling;**211**;Aug 13, 1993
+2 ;
SET(SCCVEVT,SCLOG,DFN,SCDTM,SCCLN,SCDA,SCOE,SCCV) ; Set variables
+1 ; Input -- SCCVEVT Conversion event
+2 ; SCLOG Scheduling conversion log IEN
+3 ; DFN Patient IEN
+4 ; SCDTM Appointment date/time
+5 ; SCCLN Clinic IEN
+6 ; Output -- SCDA Clinic appt patient sub-file IEN
+7 ; SCOE Outpatient encounter IEN
+8 ; SCCV Conversion array:
+9 ; SCCV("EVT") Conversion event
+10 ; ("LOG") Scheduling conversion log IEN
+11 ; ("NEW") Outpatient encounter
+12 ; created by conversion flag
+13 ; 0 = no new encounter or visit
+14 ; 1 = new encounter and visit
+15 ; 2 = new visit only
+16 ; ("SCDA") Multiple entry in ^SC for this pt
+17 ; ("OE",0) Outpatient encounter 0th node
+18 ; ("PT",0) Patient appt 0th node
+19 ; ("PT","R") Patient appt "R" node (Remarks)
+20 ; ("CL1",0) Clinic's 0th node
+21 ; ("CL",0) Clinic appt patient 0th node
+22 ; ("CL","C") Clinic appt patient "C" node (Check in/out)
+23 ; ("ERR") Code for specific error, if any
+24 ; ("VST") Visit file IEN
+25 ;
+26 NEW SCOE0,SCDATA,SCIENS
+27 ;
+28 ; Find multiple entry in ^SC for this pt
if '$GET(SCDA)
SET SCDA=+$$FIND^SDAM2(DFN,SCDTM,SCCLN)
+29 ;
+30 SET SCOE=+$PIECE($GET(^DPT(DFN,"S",SCDTM,0)),U,20)
SET SCOE0=$GET(^SCE(SCOE,0))
+31 ;
+32 ; -- following is commented out ; left for reference purposes
+33 ; -- this 'if' should always fail ; CON^SCCVEAP1 has this covered
+34 ;IF 'SCOE,'SCDA S SCCV("ERR")=1 G SETQ
+35 ;
+36 SET SCCV("SCDA")=SCDA
+37 SET SCCV("EVT")=SCCVEVT
+38 ;
+39 SET SCCV("LOG")=SCLOG
+40 SET SCCV("PT",0)=$GET(^DPT(DFN,"S",SCDTM,0))
SET SCCV("PT","R")=$GET(^("R"))
+41 SET SCCV("CL",0)=$GET(^SC(SCCLN,"S",SCDTM,1,SCDA,0))
SET SCCV("CL","C")=$GET(^("C"))
+42 SET SCCV("CL1",0)=$GET(^SC(SCCLN,0))
+43 ;
+44 ; On re-convert, delete previously converted data
+45 IF SCCVEVT=2
Begin DoDot:1
+46 NEW SCDATA
+47 ; only delete for reconvert if we created the encounter or completed
+48 ; the conversion by adding the visit
+49 if '$$CCREATE^SCCVU(SCOE)
QUIT
+50 ;
+51 SET SCCV("OE",0)=SCOE0
+52 DO RECNVT(SCOE,SCOE0,.SCCONS)
+53 SET SCOE0=$GET(^SCE(SCOE,0))
if SCOE0=""
SET SCOE=0
End DoDot:1
+54 ;
+55 SET SCCV("NEW")=$SELECT('SCOE:1,'$PIECE(SCOE0,U,5):2,1:0)
+56 ;
+57 ; Already has both an encounter and visit
if 'SCCV("NEW")
GOTO SETQ
+58 ;
+59 ; Increment total number of encounters/visits that would be created by
+60 ; conversion (if estimating)
+61 ; -- Estimate exits here
IF 'SCCVEVT
Begin DoDot:1
+62 DO INCRTOT^SCCVEGU1(.SCTOT,SCCV("NEW")+6,1)
+63 DO EN^SCCVZZ("APPT-"_(SCCV("NEW")+6),SCOE,SCDTM,$PIECE($GET(SCCV("PT",0)),U),+$PIECE(SCOE0,U,6))
+64 DO CREDIT^SCCVEAP4(SCOE,SCDTM,.SCCV,0)
End DoDot:1
GOTO SETQ
+65 ;
+66 ; Create enctr/visit
IF 'SCOE
Begin DoDot:1
+67 NEW SCCVT
+68 DO SETSCCVT^SCCVEAP2(.SCCVT,.SCCONS)
+69 IF 'SCDA
FOR
LOCK +^SC(SCCLN,"S",SCDTM,1,999999):5
IF $TEST
SET ^SC(SCCLN,"S",SCDTM,1,999999,0)=DFN
QUIT
+70 SET SCOE=$$GETAPT^SDVSIT2(DFN,SCDTM,SCCLN,"")
+71 IF 'SCDA
KILL ^SC(SCCLN,"S",SCDTM,1,999999)
LOCK -^SC(SCCLN,"S",SCDTM,1,999999)
+72 if 'SCOE
QUIT
+73 IF $PIECE($GET(^SCE(SCOE,0)),U,3)
SET SCCV("HIST")=1
+74 SET SCTOT(1.02)=$GET(SCTOT(1.02))+1
End DoDot:1
+75 ;
+76 SET SCCV("OE")=+SCOE
+77 SET SCCV("OE",0)=$GET(^SCE(+SCOE,0))
+78 SET SCCV("VST")=$PIECE(SCCV("OE",0),U,5)
+79 SET SCCV("ORG")=1
SET SCCV("REF")=SCDA
+80 ;
+81 IF 'SCCV("VST")
IF SCOE
IF SCCV("NEW")'=1
Begin DoDot:1
+82 ; create visit if encounter already exists, but no visit
SET SCCV("VST")=$$VISIT^SCCVEAP2(SCDTM,.SCCV)
+83 DO CREDIT^SCCVEAP4(SCOE,SCDTM,.SCCV,SCCVEVT)
End DoDot:1
+84 ;
SETQ QUIT
+1 ;
RECNVT(SCOE,SCOE0,SCCONS) ;Delete data added by conversion
+1 ;
+2 NEW Z,SCVST,SCENC,SCENC0,SCCHLD,PXKNOEVT
+3 ;
+4 ;Don't want event driver to fire off
SET PXKNOEVT=1
+5 ;
+6 ;Parent
SET SCVST(0,SCOE,+$PIECE(SCOE0,U,5))=+$GET(^SCE(SCOE,"CNV"))
+7 DO DELPTR(SCOE)
+8 ;
+9 SET SCENC=0
FOR
SET SCENC=$ORDER(^SCE("APAR",SCOE,SCENC))
if 'SCENC
QUIT
Begin DoDot:1
+10 SET SCVST(1,SCENC,+$PIECE($GET(^SCE(SCENC,0)),U,5))=+$GET(^SCE(SCENC,"CNV"))
+11 DO DELPTR(SCENC)
End DoDot:1
+12 ;
+13 SET SCCHLD=""
FOR
SET SCCHLD=$ORDER(SCVST(SCCHLD))
if SCCHLD=""
QUIT
SET SCENC=0
FOR
SET SCENC=$ORDER(SCVST(SCCHLD,SCENC))
if 'SCENC
QUIT
SET SCVST=""
FOR
SET SCVST=$ORDER(SCVST(SCCHLD,SCENC,SCVST))
if SCVST=""
QUIT
Begin DoDot:1
+14 ;Created by conversion - delete enctr
IF SCVST(SCCHLD,SCENC,SCVST)
IF $DATA(^SCE(SCENC,0))
DO DELE^SCCVCST2(SCENC)
+15 ;No need to delete children visits - they should go away w/parent
if 'SCVST!SCCHLD
QUIT
+16 SET Z=$$DELVFILE^PXAPI("ALL",SCVST,$GET(SCCONS("PKG")),$GET(SCCONS("SRCE")))
End DoDot:1
+17 QUIT
+18 ;
DELPTR(SCE) ; Delete visit pointer if encounter still exists
+1 ; SCE = encounter IEN
+2 NEW SCDATA
+3 IF $PIECE($GET(^SCE(SCE,0)),U,5)
SET SCDATA(.05)="@"
DO UPD^SCCVDBU(409.68,SCE,.SCDATA)
+4 ;
+5 QUIT
+6 ;
