SD53103A ;ALB/MJK - Unique Visit ID Clean Up ; March 10,1997
;;5.3;Scheduling;**103,748,766**;AUG 13, 1993;Build 3
;
Q
;
; Reference to ^TIU(8925,"V" supported by ICR #7142
; Reference to ^TIU(8925, supported by ICR #7142
;
EN ;Unique Visit ID Clean Up Option entry point
N DIR,Y,X,DIRUT
S DIR(0)="SO^1:One Entry;A:All Entries"
S DIR("A")="Enter '1' for a single entry or 'A' for All entries"
S DIR("?")="Enter '1' for a single entry or 'A' for all entries."
D ^DIR
Q:$D(DIRUT)
I Y=1 D ONE
I Y="A" D SCAN
Q
ONE ; -- entry point to select a single -1 encounter and resync
N DIC,Y,SDOE,SDPKG,SDTALK,SDEXIT,SDVST,SDTIU,SDTIU1
IF '$$INIT^SD53103B() G ONEQ
S SDTALK=1,SDEXIT=0
D HDR^SD53103B("Single") W !
F D IF SDEXIT G ONEQ
. S DIC="^SCE(",DIC("S")="N SDOE0 S SDOE0=^(0) IF $$SCREEN^SD53103A(SDOE0)",DIC(0)="AEMQ" D ^DIC
. IF +Y<1 S SDEXIT=1 Q
. ; -- display record
. S SDOE=+Y D OE^SD53103B(SDOE)
. S SDVST=$$VSIT(SDOE),SDTIU=$O(^TIU(8925,"V",SDVST,0)) ;SD*5.3*748 - Set TIU info
. IF $$OK^SD53103B() D
. . N SDX
. . S SDX=$$MSG(SDOE,$$RESYNC(SDOE))
. . IF $P(SDX,U)["RE-LINKED" D
. . . W "Re-Linked successfully:"
. . . D OE^SD53103B(SDOE)
. . . S SDTIU1=0 F S SDTIU1=$O(^TIU(8925,"V",SDVST,SDTIU1)) Q:SDTIU1="" D TIU^SD53103B(SDTIU1) ;SD*5.3*766 - Write TIU info for all linked notes
. . IF $P(SDX,U)'["RE-LINKED" D ;SD*5.3*748 - change else
. . . W $C(7),"Error has occurred.",!,"Please make a note of the following: ",!?10,SDX,!
ONEQ Q
;
SCAN ; -- entry point to scan encounter file for -1's to either
; 'count only' or 'count and fix'
N SDBEG,SDEND,SDMODE,SDPKG,SDTALK
;
; -- init global locals
IF '$$INIT^SD53103B() G SCANQ
D HDR^SD53103B("Date Range")
;
; -- get date range
IF '$$RANGE^SD53103B(.SDBEG,.SDEND) G SCANQ
;
; -- ask which mode
S SDMODE=$$MODE^SD53103B() IF 'SDMODE G SCANQ
;
; -- ask if ok to continue
IF '$$OK^SD53103B() G SCANQ
; -- queue process
D QUEUE
SCANQ Q
;
QUEUE ; queue job
N I,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
W !
S ZTIO="",ZTDESC="Fix -1 Outpatient Encounters",ZTRTN="DQ^SD53103A"
F I="SDTALK","SDMODE","SDBEG","SDEND","SDPKG" S ZTSAVE(I)=""
D ^%ZTLOAD
I $G(ZTSK) W !!,"Task queued: #",ZTSK
Q
;
;
DQ ; -- dequeue point...collect results and generate message.
N SDOE,SDOE0,SDDT,SDCNT,SDRT
; -- set up and scan records
S SDDT=SDBEG,SDCNT=0,SDRT=$NA(^TMP("SDVISIT FIX",$J)) K @SDRT
F S SDDT=$O(^SCE("B",SDDT)) Q:'SDDT!(SDDT>SDEND) D Q:$$S^%ZTLOAD
. S SDOE=""
. F S SDOE=$O(^SCE("B",SDDT,SDOE)) Q:'SDOE D
. . S SDOE0=$G(^SCE(SDOE,0)) Q:SDOE0=""
. . ; -- use only -1's
. . IF $$SCREEN(.SDOE0) D
. . . S SDCNT=SDCNT+1
. . . IF SDMODE=1 S @SDRT@(SDCNT)=$$MSG(SDOE,"COUNT ONLY")
. . . IF SDMODE=2 S @SDRT@(SDCNT)=$$MSG(SDOE,$$RESYNC(SDOE))
;
D RESULTS^SD53103B(.SDMODE,.SDBEG,.SDEND,.SDRT,.SDCNT)
K @SDRT
Q
;
SCREEN(SDOE0) ; -- process screen for -1's and null ID's
N SDOK
; -- don't use if before 10/1/96
IF +SDOE0,+SDOE0<2961001 Q 0
; -- use if -1 id
IF $P(SDOE0,U,20)=-1 Q 1
; -- use if id null and (has a completion date OR action req status)
IF $P(SDOE0,U,20)="",$P(SDOE0,U,7)!($P(SDOE0,U,12)=14) Q 1
; -- use if id nul and visit exists
IF $P(SDOE0,U,20)="",$P(SDOE0,U,5) Q 1
Q 0
;
MSG(SDOE,STATUS) ; -- build display text
N SDOE0,SDMSG,SDVT,SDTI,SDTIU
S SDOE0=$G(^SCE(+$G(SDOE),0))
IF SDOE0="" S SDMSG="Bad encounter entry passed"_U_+$G(SDOE)_U G MSGQ
S SDMSG=$S(STATUS["ERROR":">> ",1:" ")_STATUS
S SDMSG=SDMSG_U_SDOE_U_$P(SDOE0,U,6)_U_$P(SDOE0,U,5)
S SDMSG=SDMSG_U_$P($G(^DPT(+$P(SDOE0,U,2),0),"Unknown Patient"),U)
S SDMSG=SDMSG_U_$$FMTE^XLFDT(+SDOE0)
S SDMSG=SDMSG_U_$P($G(^SC(+$P(SDOE0,U,4),0),"Unknown Clinic"),U)
S SDVT=$P(SDOE0,U,5) I SDVT S SDTI=0,SDTIU="" F S SDTI=$O(^TIU(8925,"V",SDVT,SDTI)) Q:'SDTI S SDTIU=SDTIU_SDTI_", " ;SD*5.3*766 - Include All TIU Documents
S:$G(SDTIU)'="" SDMSG=SDMSG_U_$P(SDTIU,",",1,($L(SDTIU,",")-1)) ;SD*5.3*766 - Include TIU Documents in mailman message
MSGQ Q SDMSG
;
RESYNC(SDOE) ; -- resync sd and pce data
N SDOE0,SDVST,SDOK,SDOEC,SDCNT
S SDOK=0
S SDOE0=$G(^SCE(SDOE,0))
IF SDOE0="" G RESYNCQ
;
; -- get visit
S SDVST=$$VSIT(SDOE)
IF 'SDVST G RESYNCQ
D DOT
;
; -- set oe visit field
D OESET(SDOE,SDVST)
D TIUPD(SDVST)
;
; -- quit if child
IF $P(SDOE0,U,6) D G RESYNCQ
. S SDOK=1
; -- set oe visit field for children of parent
;SD*5.3*766 - Remove code that updates Child Visits
;S SDOEC=0
;F S SDOEC=$O(^SCE("APAR",SDOE,SDOEC)) Q:'SDOEC D OESET(SDOEC,SDVST),TIUPD(SDVST)
;
; -- send data to pce for parent
S SDOK=$$DATA2PCE(SDOE)
;
RESYNCQ Q $S(SDOK:"RE-LINKED",1:"ERROR OCCURRED")
;
OESET(SDOE,SDVST) ; -- set oe visit field
N DA,DR,DIE
;
; -- if id = -1 reset id
IF $P($G(^AUPNVSIT(+SDVST,150)),U)="-1"!($P($G(^AUPNVSIT(+SDVST,150)),U)="") D ;SD*5.3*766 - include null values
. N ID
. S ID=$$GETVID^VSITVID()
. K ^AUPNVSIT("VID",-1,+SDVST)
. S $P(^AUPNVSIT(+SDVST,150),U)=ID
. S ^AUPNVSIT("VID",ID,+SDVST)=""
;
S DIE="^SCE(",DR=".05////"_SDVST,DA=SDOE D ^DIE
D DOT
Q
;
VSIT(SDOE) ; -- get/find visit
N SDOE0,SDVST,VSIT,DFN,DIE,DIC,DR,DA,X,VSITPKG,SDOEP
S SDVST=0
S SDOE0=$G(^SCE(+$G(SDOE),0))
IF SDOE0="" G VSITQ
;
; -- if entry already has visit, use it
IF $P(SDOE0,U,5) S SDVST=$P(SDOE0,U,5) G VSITQ
;
; -- if parent has pointer to visit, use it
;Remove Parent Check; use Unique ID tied to Visit
;S SDOEP=$P(SDOE0,U,6)
;IF SDOEP D IF SDVST G VSITQ
;. S SDVST=$P($G(^SCE(SDOEP,0)),U,5)
;
; -- call api to get visit entry
S VSIT(0)="ENMD1"
S VSIT=+SDOE0
S DFN=+$P(SDOE0,U,2)
S VSITPKG="SD"
S VSIT("CLN")=$P(SDOE0,U,3)
S VSIT("SVC")=$S($$INP^SDAM2(DFN,VSIT)="I":"I",1:"A")
S VSIT("INS")=$P($G(^DG(40.8,+$P(SDOE0,U,11),0)),U,7)
S VSIT("ELG")=$S($P(SDOE0,U,13):$P(SDOE0,U,13),1:+$G(^DPT(DFN,.36)))
IF $P(SDOE0,U,4) S VSIT("LOC")=$P(SDOE0,U,4)
IF $P(SDOE0,U,6) S X=$G(^SCE($P(SDOE0,U,6),0)) IF X]"" S VSIT=+X I $P(X,U,5) S VSIT("LNK")=$P(X,U,5)
IF '$P(SDOE0,U,6) D
. S VSIT("PRI")="P"
E D
. IF $P(SDOE0,U,8)=4 D
. . S VSIT("PRI")="C",VSIT("SVC")=$S($$INP^SDAM2(DFN,VSIT)="I":"D",1:"X")
. E D
. . S VSIT("PRI")="S"
;
; -- do checks
I 'VSIT,'DFN,'VSIT("ELG")!('VSIT("INS"))!('VSIT("CLN")) G VSITQ
;
; -- add/find visit
;
; -- change call if orinating process is a disposition.
I $P(SDOE0,U,8)=3 D
.; -- must be valid disposition clinic
. IF $O(^PX(815,1,"DHL","B",+$P(SDOE0,U,4),0)) D DISPVSIT^PXAPI Q
.; -- if interactive mode, ok to get visit
. IF SDTALK D
. . D DISPVSIT^PXAPI
. .; -- visit created and loc defined; re-set oe location field
. . IF +$G(VSIT("IEN"))>0,VSIT("LOC") D
. . . S $P(^SCE(SDOE,0),U,4)=VSIT("LOC")
. . .; -- re-set children oe location field
. . .; SD*5.3*766 - Remove code that updates Child Visits
. . .;N SDOEC S SDOEC=0
. . .;F S SDOEC=$O(^SCE("APAR",SDOE,SDOEC)) Q:'SDOEC D
. . .; S $P(^SCE(SDOEC,0),U,4)=VSIT("LOC")
;
IF $P(SDOE0,U,8)'=3 D
.; -- quit if parent is a disposition and bad location; parent will fix
. IF $P($G(^SCE(+$P(SDOE0,U,6),0)),U,8)=3,'$O(^PX(815,1,"DHL","B",+$P(SDOE0,U,4),0)) Q
. D ^VSIT
;
IF +$G(VSIT("IEN"))>0 S SDVST=+VSIT("IEN")
VSITQ Q SDVST
;
DATA2PCE(SDOE) ; -- send data to pce
N SDOE0,X,SDVST,SDPRV,SDIAG,SDCLS,SDPROC,SDPCE,SDOK,SDOEC
S SDOK=0
;
; -- gather needed data
S SDOE0=$G(^SCE(SDOE,0)) G DATAQ:SDOE0=""
S SDVST=$P(SDOE0,U,5) G DATAQ:'SDVST
;
; -- if visit has v-file data quit
IF $O(^AUPNVCPT("AD",SDVST,0))!($O(^AUPNVPRV("AD",SDVST,0)))!($O(^AUPNVPOV("AD",SDVST,0))) S SDOK=1 G DATAQ
;
; -- get data from parent
D SET(SDOE,"SDPRV",409.44),DOT
D SET(SDOE,"SDIAG",409.43),DOT
D SET(SDOE,"SDCLS",409.42),DOT
D PROC^SCDXUTL0(SDOE,"SDPROC"),DOT ; -- gets both parent & children data
;
; -- get data from children
S SDOEC=0
F S SDOEC=$O(^SCE("APAR",SDOE,SDOEC)) Q:'SDOEC D
. D SET(SDOEC,"SDPRV",409.44),DOT
. D SET(SDOEC,"SDIAG",409.43),DOT
. D SET(SDOEC,"SDCLS",409.42),DOT
;
; ---build pce data array
D BUILD("SDPRV","SDIAG","SDCLS","SDPROC","SDPCE")
;
; -- call pce api to file data
IF $$DATA2PCE^PXAPI("SDPCE",SDPKG,"SD TO PCE RESYNC",SDVST)=1 D
. S SDOK=1
DATAQ Q SDOK
;
BUILD(SDPROV,SDDX,SDCLASS,SDCPT,SDATA) ; -- build pce data array
N X,SDI,SDIEN,SDCNT
S SDI=0 F S SDI=$O(@SDCLASS@(SDI)) Q:'SDI D
. S X=@SDCLASS@(SDI)
. S @SDATA@("ENCOUNTER",1,$P("AO^IR^SC^EC",U,+X))=$P(X,U,3)
;
; -- set provider info
IF $O(@SDPROV@(0)) D
. S (SDCNT,SDIEN)=0
. F S SDIEN=$O(@SDPROV@(SDIEN)) Q:'SDIEN D
. . S X=@SDPROV@(SDIEN)
. . S SDCNT=SDCNT+1
. . S @SDATA@("PROVIDER",SDCNT,"NAME")=+X
;
; -- set dx info
IF $O(@SDDX@(0)) D
. S (SDCNT,SDIEN)=0
. F S SDIEN=$O(@SDDX@(SDIEN)) Q:'SDIEN D
. . S X=@SDDX@(SDIEN)
. . S SDCNT=SDCNT+1
. . S @SDATA@("DX/PL",SDCNT,"DIAGNOSIS")=+X
. . S @SDATA@("DX/PL",SDCNT,"PRIMARY")=+$P(X,U,3)
;
; -- set cpt info
IF $O(@SDCPT@(0)) D
. ; -- count times performed
. N SDX
. S (SDCNT,SDIEN)=0
. F S SDIEN=$O(@SDCPT@(SDIEN)) Q:'SDIEN D
. . S X=@SDCPT@(SDIEN)
. . S SDX(+X)=$G(SDX(+X))+1
. ;
. ; -- build nodes
. S (SDCNT,SDIEN)=0
. F S SDIEN=$O(SDX(SDIEN)) Q:'SDIEN D
. . S X=SDX(SDIEN)
. . S SDCNT=SDCNT+1
. . S @SDATA@("PROCEDURE",SDCNT,"PROCEDURE")=SDIEN
. . S @SDATA@("PROCEDURE",SDCNT,"QTY")=+X
BUILDQ Q
;
SET(SDOE,ARRAY,FILE) ;Set-up Array for Outpatient Encounter
; Input -- SDOE Outpatient Encounter IEN
; Output -- ARRAY Provider or dx Array Subscripted by a ien
;
N SDIEN
S SDIEN=0
F S SDIEN=$O(^SDD(FILE,"OE",SDOE,SDIEN)) Q:'SDIEN D
. S X=$G(^SDD(FILE,SDIEN,0)) Q:X=""
. S @ARRAY@(SDIEN)=X
SETQ Q
;
DOT ; -- write '.' if ok to talk
IF SDTALK D
. W "."
Q
;
TIUPD(SDVST) ;Correct TIU document if applicable, SD*5.3*748
N DA,DIK
S DA=0 F S DA=$O(^TIU(8925,"V",SDVST,DA)) Q:'DA S DIK="^TIU(8925,",DIK(1)=".03^7" D EN1^DIK ;SD*5.3*766 - Loop to get all entries tied to Visit
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53103A 10091 printed Oct 16, 2024@18:45:18 Page 2
SD53103A ;ALB/MJK - Unique Visit ID Clean Up ; March 10,1997
+1 ;;5.3;Scheduling;**103,748,766**;AUG 13, 1993;Build 3
+2 ;
+3 QUIT
+4 ;
+5 ; Reference to ^TIU(8925,"V" supported by ICR #7142
+6 ; Reference to ^TIU(8925, supported by ICR #7142
+7 ;
EN ;Unique Visit ID Clean Up Option entry point
+1 NEW DIR,Y,X,DIRUT
+2 SET DIR(0)="SO^1:One Entry;A:All Entries"
+3 SET DIR("A")="Enter '1' for a single entry or 'A' for All entries"
+4 SET DIR("?")="Enter '1' for a single entry or 'A' for all entries."
+5 DO ^DIR
+6 if $DATA(DIRUT)
QUIT
+7 IF Y=1
DO ONE
+8 IF Y="A"
DO SCAN
+9 QUIT
ONE ; -- entry point to select a single -1 encounter and resync
+1 NEW DIC,Y,SDOE,SDPKG,SDTALK,SDEXIT,SDVST,SDTIU,SDTIU1
+2 IF '$$INIT^SD53103B()
GOTO ONEQ
+3 SET SDTALK=1
SET SDEXIT=0
+4 DO HDR^SD53103B("Single")
WRITE !
+5 FOR
Begin DoDot:1
+6 SET DIC="^SCE("
SET DIC("S")="N SDOE0 S SDOE0=^(0) IF $$SCREEN^SD53103A(SDOE0)"
SET DIC(0)="AEMQ"
DO ^DIC
+7 IF +Y<1
SET SDEXIT=1
QUIT
+8 ; -- display record
+9 SET SDOE=+Y
DO OE^SD53103B(SDOE)
+10 ;SD*5.3*748 - Set TIU info
SET SDVST=$$VSIT(SDOE)
SET SDTIU=$ORDER(^TIU(8925,"V",SDVST,0))
+11 IF $$OK^SD53103B()
Begin DoDot:2
+12 NEW SDX
+13 SET SDX=$$MSG(SDOE,$$RESYNC(SDOE))
+14 IF $PIECE(SDX,U)["RE-LINKED"
Begin DoDot:3
+15 WRITE "Re-Linked successfully:"
+16 DO OE^SD53103B(SDOE)
+17 ;SD*5.3*766 - Write TIU info for all linked notes
SET SDTIU1=0
FOR
SET SDTIU1=$ORDER(^TIU(8925,"V",SDVST,SDTIU1))
if SDTIU1=""
QUIT
DO TIU^SD53103B(SDTIU1)
End DoDot:3
+18 ;SD*5.3*748 - change else
IF $PIECE(SDX,U)'["RE-LINKED"
Begin DoDot:3
+19 WRITE $CHAR(7),"Error has occurred.",!,"Please make a note of the following: ",!?10,SDX,!
End DoDot:3
End DoDot:2
End DoDot:1
IF SDEXIT
GOTO ONEQ
ONEQ QUIT
+1 ;
SCAN ; -- entry point to scan encounter file for -1's to either
+1 ; 'count only' or 'count and fix'
+2 NEW SDBEG,SDEND,SDMODE,SDPKG,SDTALK
+3 ;
+4 ; -- init global locals
+5 IF '$$INIT^SD53103B()
GOTO SCANQ
+6 DO HDR^SD53103B("Date Range")
+7 ;
+8 ; -- get date range
+9 IF '$$RANGE^SD53103B(.SDBEG,.SDEND)
GOTO SCANQ
+10 ;
+11 ; -- ask which mode
+12 SET SDMODE=$$MODE^SD53103B()
IF 'SDMODE
GOTO SCANQ
+13 ;
+14 ; -- ask if ok to continue
+15 IF '$$OK^SD53103B()
GOTO SCANQ
+16 ; -- queue process
+17 DO QUEUE
SCANQ QUIT
+1 ;
QUEUE ; queue job
+1 NEW I,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
+2 WRITE !
+3 SET ZTIO=""
SET ZTDESC="Fix -1 Outpatient Encounters"
SET ZTRTN="DQ^SD53103A"
+4 FOR I="SDTALK","SDMODE","SDBEG","SDEND","SDPKG"
SET ZTSAVE(I)=""
+5 DO ^%ZTLOAD
+6 IF $GET(ZTSK)
WRITE !!,"Task queued: #",ZTSK
+7 QUIT
+8 ;
+9 ;
DQ ; -- dequeue point...collect results and generate message.
+1 NEW SDOE,SDOE0,SDDT,SDCNT,SDRT
+2 ; -- set up and scan records
+3 SET SDDT=SDBEG
SET SDCNT=0
SET SDRT=$NAME(^TMP("SDVISIT FIX",$JOB))
KILL @SDRT
+4 FOR
SET SDDT=$ORDER(^SCE("B",SDDT))
if 'SDDT!(SDDT>SDEND)
QUIT
Begin DoDot:1
+5 SET SDOE=""
+6 FOR
SET SDOE=$ORDER(^SCE("B",SDDT,SDOE))
if 'SDOE
QUIT
Begin DoDot:2
+7 SET SDOE0=$GET(^SCE(SDOE,0))
if SDOE0=""
QUIT
+8 ; -- use only -1's
+9 IF $$SCREEN(.SDOE0)
Begin DoDot:3
+10 SET SDCNT=SDCNT+1
+11 IF SDMODE=1
SET @SDRT@(SDCNT)=$$MSG(SDOE,"COUNT ONLY")
+12 IF SDMODE=2
SET @SDRT@(SDCNT)=$$MSG(SDOE,$$RESYNC(SDOE))
End DoDot:3
End DoDot:2
End DoDot:1
if $$S^%ZTLOAD
QUIT
+13 ;
+14 DO RESULTS^SD53103B(.SDMODE,.SDBEG,.SDEND,.SDRT,.SDCNT)
+15 KILL @SDRT
+16 QUIT
+17 ;
SCREEN(SDOE0) ; -- process screen for -1's and null ID's
+1 NEW SDOK
+2 ; -- don't use if before 10/1/96
+3 IF +SDOE0
IF +SDOE0<2961001
QUIT 0
+4 ; -- use if -1 id
+5 IF $PIECE(SDOE0,U,20)=-1
QUIT 1
+6 ; -- use if id null and (has a completion date OR action req status)
+7 IF $PIECE(SDOE0,U,20)=""
IF $PIECE(SDOE0,U,7)!($PIECE(SDOE0,U,12)=14)
QUIT 1
+8 ; -- use if id nul and visit exists
+9 IF $PIECE(SDOE0,U,20)=""
IF $PIECE(SDOE0,U,5)
QUIT 1
+10 QUIT 0
+11 ;
MSG(SDOE,STATUS) ; -- build display text
+1 NEW SDOE0,SDMSG,SDVT,SDTI,SDTIU
+2 SET SDOE0=$GET(^SCE(+$GET(SDOE),0))
+3 IF SDOE0=""
SET SDMSG="Bad encounter entry passed"_U_+$GET(SDOE)_U
GOTO MSGQ
+4 SET SDMSG=$SELECT(STATUS["ERROR":">> ",1:" ")_STATUS
+5 SET SDMSG=SDMSG_U_SDOE_U_$PIECE(SDOE0,U,6)_U_$PIECE(SDOE0,U,5)
+6 SET SDMSG=SDMSG_U_$PIECE($GET(^DPT(+$PIECE(SDOE0,U,2),0),"Unknown Patient"),U)
+7 SET SDMSG=SDMSG_U_$$FMTE^XLFDT(+SDOE0)
+8 SET SDMSG=SDMSG_U_$PIECE($GET(^SC(+$PIECE(SDOE0,U,4),0),"Unknown Clinic"),U)
+9 ;SD*5.3*766 - Include All TIU Documents
SET SDVT=$PIECE(SDOE0,U,5)
IF SDVT
SET SDTI=0
SET SDTIU=""
FOR
SET SDTI=$ORDER(^TIU(8925,"V",SDVT,SDTI))
if 'SDTI
QUIT
SET SDTIU=SDTIU_SDTI_", "
+10 ;SD*5.3*766 - Include TIU Documents in mailman message
if $GET(SDTIU)'=""
SET SDMSG=SDMSG_U_$PIECE(SDTIU,",",1,($LENGTH(SDTIU,",")-1))
MSGQ QUIT SDMSG
+1 ;
RESYNC(SDOE) ; -- resync sd and pce data
+1 NEW SDOE0,SDVST,SDOK,SDOEC,SDCNT
+2 SET SDOK=0
+3 SET SDOE0=$GET(^SCE(SDOE,0))
+4 IF SDOE0=""
GOTO RESYNCQ
+5 ;
+6 ; -- get visit
+7 SET SDVST=$$VSIT(SDOE)
+8 IF 'SDVST
GOTO RESYNCQ
+9 DO DOT
+10 ;
+11 ; -- set oe visit field
+12 DO OESET(SDOE,SDVST)
+13 DO TIUPD(SDVST)
+14 ;
+15 ; -- quit if child
+16 IF $PIECE(SDOE0,U,6)
Begin DoDot:1
+17 SET SDOK=1
End DoDot:1
GOTO RESYNCQ
+18 ; -- set oe visit field for children of parent
+19 ;SD*5.3*766 - Remove code that updates Child Visits
+20 ;S SDOEC=0
+21 ;F S SDOEC=$O(^SCE("APAR",SDOE,SDOEC)) Q:'SDOEC D OESET(SDOEC,SDVST),TIUPD(SDVST)
+22 ;
+23 ; -- send data to pce for parent
+24 SET SDOK=$$DATA2PCE(SDOE)
+25 ;
RESYNCQ QUIT $SELECT(SDOK:"RE-LINKED",1:"ERROR OCCURRED")
+1 ;
OESET(SDOE,SDVST) ; -- set oe visit field
+1 NEW DA,DR,DIE
+2 ;
+3 ; -- if id = -1 reset id
+4 ;SD*5.3*766 - include null values
IF $PIECE($GET(^AUPNVSIT(+SDVST,150)),U)="-1"!($PIECE($GET(^AUPNVSIT(+SDVST,150)),U)="")
Begin DoDot:1
+5 NEW ID
+6 SET ID=$$GETVID^VSITVID()
+7 KILL ^AUPNVSIT("VID",-1,+SDVST)
+8 SET $PIECE(^AUPNVSIT(+SDVST,150),U)=ID
+9 SET ^AUPNVSIT("VID",ID,+SDVST)=""
End DoDot:1
+10 ;
+11 SET DIE="^SCE("
SET DR=".05////"_SDVST
SET DA=SDOE
DO ^DIE
+12 DO DOT
+13 QUIT
+14 ;
VSIT(SDOE) ; -- get/find visit
+1 NEW SDOE0,SDVST,VSIT,DFN,DIE,DIC,DR,DA,X,VSITPKG,SDOEP
+2 SET SDVST=0
+3 SET SDOE0=$GET(^SCE(+$GET(SDOE),0))
+4 IF SDOE0=""
GOTO VSITQ
+5 ;
+6 ; -- if entry already has visit, use it
+7 IF $PIECE(SDOE0,U,5)
SET SDVST=$PIECE(SDOE0,U,5)
GOTO VSITQ
+8 ;
+9 ; -- if parent has pointer to visit, use it
+10 ;Remove Parent Check; use Unique ID tied to Visit
+11 ;S SDOEP=$P(SDOE0,U,6)
+12 ;IF SDOEP D IF SDVST G VSITQ
+13 ;. S SDVST=$P($G(^SCE(SDOEP,0)),U,5)
+14 ;
+15 ; -- call api to get visit entry
+16 SET VSIT(0)="ENMD1"
+17 SET VSIT=+SDOE0
+18 SET DFN=+$PIECE(SDOE0,U,2)
+19 SET VSITPKG="SD"
+20 SET VSIT("CLN")=$PIECE(SDOE0,U,3)
+21 SET VSIT("SVC")=$SELECT($$INP^SDAM2(DFN,VSIT)="I":"I",1:"A")
+22 SET VSIT("INS")=$PIECE($GET(^DG(40.8,+$PIECE(SDOE0,U,11),0)),U,7)
+23 SET VSIT("ELG")=$SELECT($PIECE(SDOE0,U,13):$PIECE(SDOE0,U,13),1:+$GET(^DPT(DFN,.36)))
+24 IF $PIECE(SDOE0,U,4)
SET VSIT("LOC")=$PIECE(SDOE0,U,4)
+25 IF $PIECE(SDOE0,U,6)
SET X=$GET(^SCE($PIECE(SDOE0,U,6),0))
IF X]""
SET VSIT=+X
IF $PIECE(X,U,5)
SET VSIT("LNK")=$PIECE(X,U,5)
+26 IF '$PIECE(SDOE0,U,6)
Begin DoDot:1
+27 SET VSIT("PRI")="P"
End DoDot:1
+28 IF '$TEST
Begin DoDot:1
+29 IF $PIECE(SDOE0,U,8)=4
Begin DoDot:2
+30 SET VSIT("PRI")="C"
SET VSIT("SVC")=$SELECT($$INP^SDAM2(DFN,VSIT)="I":"D",1:"X")
End DoDot:2
+31 IF '$TEST
Begin DoDot:2
+32 SET VSIT("PRI")="S"
End DoDot:2
End DoDot:1
+33 ;
+34 ; -- do checks
+35 IF 'VSIT
IF 'DFN
IF 'VSIT("ELG")!('VSIT("INS"))!('VSIT("CLN"))
GOTO VSITQ
+36 ;
+37 ; -- add/find visit
+38 ;
+39 ; -- change call if orinating process is a disposition.
+40 IF $PIECE(SDOE0,U,8)=3
Begin DoDot:1
+41 ; -- must be valid disposition clinic
+42 IF $ORDER(^PX(815,1,"DHL","B",+$PIECE(SDOE0,U,4),0))
DO DISPVSIT^PXAPI
QUIT
+43 ; -- if interactive mode, ok to get visit
+44 IF SDTALK
Begin DoDot:2
+45 DO DISPVSIT^PXAPI
+46 ; -- visit created and loc defined; re-set oe location field
+47 IF +$GET(VSIT("IEN"))>0
IF VSIT("LOC")
Begin DoDot:3
+48 SET $PIECE(^SCE(SDOE,0),U,4)=VSIT("LOC")
+49 ; -- re-set children oe location field
+50 ; SD*5.3*766 - Remove code that updates Child Visits
+51 ;N SDOEC S SDOEC=0
+52 ;F S SDOEC=$O(^SCE("APAR",SDOE,SDOEC)) Q:'SDOEC D
+53 ; S $P(^SCE(SDOEC,0),U,4)=VSIT("LOC")
End DoDot:3
End DoDot:2
End DoDot:1
+54 ;
+55 IF $PIECE(SDOE0,U,8)'=3
Begin DoDot:1
+56 ; -- quit if parent is a disposition and bad location; parent will fix
+57 IF $PIECE($GET(^SCE(+$PIECE(SDOE0,U,6),0)),U,8)=3
IF '$ORDER(^PX(815,1,"DHL","B",+$PIECE(SDOE0,U,4),0))
QUIT
+58 DO ^VSIT
End DoDot:1
+59 ;
+60 IF +$GET(VSIT("IEN"))>0
SET SDVST=+VSIT("IEN")
VSITQ QUIT SDVST
+1 ;
DATA2PCE(SDOE) ; -- send data to pce
+1 NEW SDOE0,X,SDVST,SDPRV,SDIAG,SDCLS,SDPROC,SDPCE,SDOK,SDOEC
+2 SET SDOK=0
+3 ;
+4 ; -- gather needed data
+5 SET SDOE0=$GET(^SCE(SDOE,0))
if SDOE0=""
GOTO DATAQ
+6 SET SDVST=$PIECE(SDOE0,U,5)
if 'SDVST
GOTO DATAQ
+7 ;
+8 ; -- if visit has v-file data quit
+9 IF $ORDER(^AUPNVCPT("AD",SDVST,0))!($ORDER(^AUPNVPRV("AD",SDVST,0)))!($ORDER(^AUPNVPOV("AD",SDVST,0)))
SET SDOK=1
GOTO DATAQ
+10 ;
+11 ; -- get data from parent
+12 DO SET(SDOE,"SDPRV",409.44)
DO DOT
+13 DO SET(SDOE,"SDIAG",409.43)
DO DOT
+14 DO SET(SDOE,"SDCLS",409.42)
DO DOT
+15 ; -- gets both parent & children data
DO PROC^SCDXUTL0(SDOE,"SDPROC")
DO DOT
+16 ;
+17 ; -- get data from children
+18 SET SDOEC=0
+19 FOR
SET SDOEC=$ORDER(^SCE("APAR",SDOE,SDOEC))
if 'SDOEC
QUIT
Begin DoDot:1
+20 DO SET(SDOEC,"SDPRV",409.44)
DO DOT
+21 DO SET(SDOEC,"SDIAG",409.43)
DO DOT
+22 DO SET(SDOEC,"SDCLS",409.42)
DO DOT
End DoDot:1
+23 ;
+24 ; ---build pce data array
+25 DO BUILD("SDPRV","SDIAG","SDCLS","SDPROC","SDPCE")
+26 ;
+27 ; -- call pce api to file data
+28 IF $$DATA2PCE^PXAPI("SDPCE",SDPKG,"SD TO PCE RESYNC",SDVST)=1
Begin DoDot:1
+29 SET SDOK=1
End DoDot:1
DATAQ QUIT SDOK
+1 ;
BUILD(SDPROV,SDDX,SDCLASS,SDCPT,SDATA) ; -- build pce data array
+1 NEW X,SDI,SDIEN,SDCNT
+2 SET SDI=0
FOR
SET SDI=$ORDER(@SDCLASS@(SDI))
if 'SDI
QUIT
Begin DoDot:1
+3 SET X=@SDCLASS@(SDI)
+4 SET @SDATA@("ENCOUNTER",1,$PIECE("AO^IR^SC^EC",U,+X))=$PIECE(X,U,3)
End DoDot:1
+5 ;
+6 ; -- set provider info
+7 IF $ORDER(@SDPROV@(0))
Begin DoDot:1
+8 SET (SDCNT,SDIEN)=0
+9 FOR
SET SDIEN=$ORDER(@SDPROV@(SDIEN))
if 'SDIEN
QUIT
Begin DoDot:2
+10 SET X=@SDPROV@(SDIEN)
+11 SET SDCNT=SDCNT+1
+12 SET @SDATA@("PROVIDER",SDCNT,"NAME")=+X
End DoDot:2
End DoDot:1
+13 ;
+14 ; -- set dx info
+15 IF $ORDER(@SDDX@(0))
Begin DoDot:1
+16 SET (SDCNT,SDIEN)=0
+17 FOR
SET SDIEN=$ORDER(@SDDX@(SDIEN))
if 'SDIEN
QUIT
Begin DoDot:2
+18 SET X=@SDDX@(SDIEN)
+19 SET SDCNT=SDCNT+1
+20 SET @SDATA@("DX/PL",SDCNT,"DIAGNOSIS")=+X
+21 SET @SDATA@("DX/PL",SDCNT,"PRIMARY")=+$PIECE(X,U,3)
End DoDot:2
End DoDot:1
+22 ;
+23 ; -- set cpt info
+24 IF $ORDER(@SDCPT@(0))
Begin DoDot:1
+25 ; -- count times performed
+26 NEW SDX
+27 SET (SDCNT,SDIEN)=0
+28 FOR
SET SDIEN=$ORDER(@SDCPT@(SDIEN))
if 'SDIEN
QUIT
Begin DoDot:2
+29 SET X=@SDCPT@(SDIEN)
+30 SET SDX(+X)=$GET(SDX(+X))+1
End DoDot:2
+31 ;
+32 ; -- build nodes
+33 SET (SDCNT,SDIEN)=0
+34 FOR
SET SDIEN=$ORDER(SDX(SDIEN))
if 'SDIEN
QUIT
Begin DoDot:2
+35 SET X=SDX(SDIEN)
+36 SET SDCNT=SDCNT+1
+37 SET @SDATA@("PROCEDURE",SDCNT,"PROCEDURE")=SDIEN
+38 SET @SDATA@("PROCEDURE",SDCNT,"QTY")=+X
End DoDot:2
End DoDot:1
BUILDQ QUIT
+1 ;
SET(SDOE,ARRAY,FILE) ;Set-up Array for Outpatient Encounter
+1 ; Input -- SDOE Outpatient Encounter IEN
+2 ; Output -- ARRAY Provider or dx Array Subscripted by a ien
+3 ;
+4 NEW SDIEN
+5 SET SDIEN=0
+6 FOR
SET SDIEN=$ORDER(^SDD(FILE,"OE",SDOE,SDIEN))
if 'SDIEN
QUIT
Begin DoDot:1
+7 SET X=$GET(^SDD(FILE,SDIEN,0))
if X=""
QUIT
+8 SET @ARRAY@(SDIEN)=X
End DoDot:1
SETQ QUIT
+1 ;
DOT ; -- write '.' if ok to talk
+1 IF SDTALK
Begin DoDot:1
+2 WRITE "."
End DoDot:1
+3 QUIT
+4 ;
TIUPD(SDVST) ;Correct TIU document if applicable, SD*5.3*748
+1 NEW DA,DIK
+2 ;SD*5.3*766 - Loop to get all entries tied to Visit
SET DA=0
FOR
SET DA=$ORDER(^TIU(8925,"V",SDVST,DA))
if 'DA
QUIT
SET DIK="^TIU(8925,"
SET DIK(1)=".03^7"
DO EN1^DIK
+3 QUIT
