- ECUTL2 ;ALB/JAM - Event Capture Diagnosis Code Selection ;23 Aug 2007
- ;;2.0;EVENT CAPTURE;**23,33,47,63,72,95,114**;8 May 96;Build 20
- ;
- ; Reference to $$SINFO^ICDEX supported by ICR #5747
- ; Reference to $$ICDDX^ICDEX supported by ICR5747
- ;
- DIAG ;ask dx question (primary and multiple secondary)
- ;check for primary dx and display message
- D PDXMSG
- ;ask for primary dx
- D PDX I ECOUT Q
- ;ask for secondary dx
- D SDX I ECOUT Q
- I $D(DTOUT)!$D(DUOUT) W:$P(ECPCE,"~",2)'="N" !!,"Please note that this record cannot be sent to PCE without a diagnosis.",!!
- Q
- PDXMSG ; Check for existence of primary diagnoses and display message
- N TXT,ECPDX
- S (ECDX,ECDXN,ECDXO)="" K ECDXS
- ;Check if primary dx exist in file #721
- S ECPDX=$$PDXCK(ECDFN,ECDT,ECL,EC4)
- I +ECPDX W ! D
- . W !?5,"WARNING: Primary Diagnoses already on File for this encounter."
- . W !?5,"If changed, all procedures will be updated. ("_ECDXN_")"
- . S ECDXO=ECDX
- I $P(ECPDX,U,2) D
- . S TXT="WARNING: Primary diagnoses already sent to PCE. If changed,"
- . S TXT=TXT_" all procedures"
- . W !!?5,TXT
- . S TXT="associated with this encounter will be updated and resent "
- . S TXT=TXT_"to PCE."
- . W !?5,TXT
- Q
- PDXCK(ECDFN,ECDTX,ECLX,EC4X) ;Get primary dx frm file #721 for pat encounter
- ; Input: ECDFN = Patient ien
- ; ECDTX = Date/time of procedure
- ; ECLX = Location ien
- ; EC4X = Clinic ien
- ;
- ; Output: PDXF^PCEF = primary dx flag (1/0)^dx sent to PCE flag (1/0)
- ; ECDX = Primary diagnoses ien
- ; ECDXN = Primary diagnoses code
- ; ECDXIEN = Array of encounter IENs w primary dx
- ;
- N PDXF,PCEF,DA,DXIEN,DXS,DXN,ECCS
- S (PDXF,PCEF)=0,DA="" K ECDXIEN
- I $G(ECDFN)=""!($G(ECDTX)="")!($G(ECLX)="")!($G(EC4X)="") Q PDXF_U_PCEF
- I $O(^ECH("APAT",ECDFN,ECDTX,""))="" Q PDXF_U_PCEF
- F S DA=$O(^ECH("APAT",ECDFN,ECDTX,DA)) Q:DA="" D
- .I EC4X'=$P($G(^ECH(DA,0)),U,19) Q
- .S ECDX=$P($G(^ECH(DA,"P")),U,2) I ECDX="" Q
- .; Determine Active Coding System Based on Date of Interest
- .S ECCS=$$SINFO^ICDEX("DIAG",ECDTX) ; Supported by ICR 5747
- .; Retrieve ICD info - Supported by ICR 5747
- .S ECDXN=$P($$ICDDX^ICDEX(ECDX,ECDTX,+ECCS,"I"),U,2)
- .S ECDXIEN(DA)=ECDXN_U_ECDX,PDXF=1
- .I $D(^ECH(DA,"SEND")),^("SEND")="" S PCEF=1
- .I $D(^ECH(DA,"DX")) D
- ..S DXS=0 F S DXS=$O(^ECH(DA,"DX",DXS)) Q:'DXS D
- ...S DXIEN=$P($G(^ECH(DA,"DX",DXS,0)),U)
- ...; Retrieve ICD info - Supported by ICR 5747
- ...S DXN=$P($$ICDDX^ICDEX(DXIEN,ECDTX,+ECCS,"I"),U,2) S:DXN'="" ECDXS(DXN)=DXIEN
- Q PDXF_U_PCEF
- PDX ;Ask primary diagnoses code
- ; Variables: ECDX = Primary diagnoses ien
- ; ECDXN = Primary diagnoses code, default if define
- ; ECOUT = Error flag (1/0)
- ;
- N DIC,X,Y,DTOUT,DUOUT,DEFX,ECODE,PROMPT,ECCS
- S ECDX=$G(ECDX),ECDXN=$G(ECDXN),PROMPT="Primary ICD Code: "
- S:ECDXN'="" DEFX=ECDXN
- F D LEX Q:$G(ECOUT) D I $D(ECODE) Q
- .I X="" W !,"This is a required response. Enter '^' to exit" Q
- .S ECDXN=ECODE
- .S ECCS=$$SINFO^ICDEX("DIAG",$G(ECDT)) ; Supported by ICR 5747
- .S ECDX=$$ICDDX^ICDEX(ECODE,$G(ECDT),+ECCS,"E") ; Supported by ICR 5747
- Q
- SDX ;Ask secondary diagnoses code
- ; Variables: ECDX = Primary diagnoses ien, default if define
- ; ECDXN = Primary diagnoses code
- ; ECOUT = Error flag (1/0)
- ; ECDXS = Array with secondary diagnosis code
- ; subscript=dx code and set equal to dx ien
- ;
- N Y,X,DEFX,DIC,DTOUT,DUOUT,ECODE,ECCS
- S ECOUT=$G(ECOUT),PROMPT="Secondary ICD Code: "
- F D LSTDXS,LEX Q:Y<0 D I ECOUT Q
- .I ECODE="" Q
- .I ECODE=$G(ECDXN) W " Already exist as primary dx." Q
- .I $D(ECDXS(ECODE)) D DELDUP Q
- .; Determine Active Coding System Based on Date of Interest
- .S ECCS=$$SINFO^ICDEX("DIAG",$G(ECDT)) ; Supported by ICR 5747
- .S ECDXS(ECODE)=+$$ICDDX^ICDEX(ECODE,$G(ECDT),+ECCS,"E") ; Supported by ICR 5747
- Q
- DELDUP ;Delete secondary diagnosis code from list
- N DIR,DIRUT,DTOUT,DUOUT,DIROUT
- S DIR("A")="Delete "_ECODE_" Code from List"
- S DIR(0)="Y"
- D ^DIR
- I $D(DIRUT)!($D(DIROUT)) S ECOUT=1 Q
- I Y K ECDXS(ECODE)
- Q
- ;
- LEX ;ICD code from LEX database
- ;K X,Y
- N IMP,APP,ECX
- S (ECX,X)=$G(DEFX)
- ;LEX DBIA1577
- S IMP=$$IMPDATE^LEXU("10D"),APP=$S(ECDT<IMP:"ICD",1:"10D") ; Supported by ICR 5679
- D CONFIG^LEXSET(APP,APP,$G(ECDT))
- D LOOK^LEXA(ECX,APP,1,"",ECDT) ;LEX DBIA2950
- S DIC="757.01",DIC(0)=$S('$L($G(X)):"A",1:"")_"EQM",DIC("A")=PROMPT
- D ^DIC
- I $D(DTOUT)!$D(DUOUT) S ECOUT=1 Q
- I X="" Q
- I Y<0 S ECOUT=1 Q
- S ECODE=$G(Y(1))
- Q
- ;
- LSTDXS ;list ICD code
- N DXS,ECCS
- I $D(ECDXS) D
- . W !?1,"Secondary ICD code entered:"
- . S DXS=""
- . F S DXS=$O(ECDXS(DXS)) Q:DXS="" D
- . . ; Determine Active Coding System Based on Date of Interest
- . . S ECCS=$$SINFO^ICDEX("DIAG",$G(ECDT)) ; Supported by ICR 5747
- . . W !,?4,DXS,?15,$P($$ICDDX^ICDEX(DXS,$G(ECDT),+ECCS,"E"),"^",4) ; Supported by ICR 5747
- Q
- PXUPD(ECDFN,ECDT,ECL,EC4,ECDXP,ECDXX,ECXIEN) ; Update all associated
- ; procedures for an EC Patient encounter with the same primary and
- ; secondary dx codes
- ;
- ; Input: ECDFN = Patient ien
- ; ECDT = Date/time of procedure
- ; ECL = Location ien
- ; EC4 = Clinic ien
- ; ECDXP = Primary diagnoses code
- ; ECDXX = Array of secondary diagnoses codes
- ; ECXIEN = 721 ien, if define don't process
- ;
- ; Output: ECERR 0 - Process completed
- ;
- N ECIEN,ECERR,DIE,DR,DA,DTOUT,DIROUT,ECDXIEN,ECPDX,ECDX,ECDXN,DIC,X
- N ECVST,ECVAR1,VALQUIET,DXN,DXSIEN,DIK,ECDXS
- S ECERR=0
- I $D(ECDXP)="" Q ECERR
- S ECPDX=$$PDXCK(ECDFN,ECDT,ECL,EC4)
- I '$D(ECDXIEN) Q ECERR
- S ECIEN="",DIE="^ECH("
- F S ECIEN=$O(ECDXIEN(ECIEN)) Q:ECIEN="" D
- . I $G(ECXIEN)'="",ECXIEN=ECIEN Q
- . S ECNODE=$G(^ECH(ECIEN,"P")) I ECNODE="" Q
- . I ECDXP'=$P(ECNODE,U,2) D
- . . S DA=ECIEN,DR="20////"_ECDXP D ^DIE
- . . S $P(^ECH(ECIEN,"PCE"),"~",11)=ECDXP
- . ;delete all secondary diagnosis codes
- . S DA(1)=ECIEN,DIK="^ECH("_DA(1)_",""DX"",",DA=0
- . F S DA=$O(^ECH(ECIEN,"DX",DA)) Q:'DA D ^DIK
- . I $D(^ECH(ECIEN,"DX")) K ^ECH(ECIEN,"DX")
- . ;update secondary diagnosis codes on procedure
- . S DXN="" F S DXN=$O(ECDXX(DXN)) Q:DXN="" D
- . . S DXSIEN=$P(ECDXX(DXN),U) I DXSIEN<0 Q
- . . K DIC,DD,DO S DIC(0)="L",DA(1)=ECIEN,DIC("P")=$P(^DD(721,38,0),U,2)
- . . S X=DXSIEN,DIC="^ECH("_DA(1)_","_"""DX"""_"," D FILE^DICN
- . ;delete visit and resend to PCE
- . S ECVST=+$P($G(^ECH(ECIEN,0)),"^",21) I 'ECVST Q
- . ;* Prepare all EC records with same Visit file entry to resend to PCE
- . K EC2PCE S ECVAR1=$$FNDVST^ECUTL(ECVST,,.EC2PCE)
- . ;- Set VALQUIET to stop Amb Care validator from broadcasting to screen
- . N ECPKG,ECSOU
- . S ECPKG=$O(^DIC(9.4,"B","EVENT CAPTURE",0)),ECSOU="EVENT CAPTURE DATA"
- . S VALQUIET=1,ECVV=$$DELVFILE^PXAPI("ALL",ECVST,ECPKG,ECSOU)
- . ;- Send to PCE task
- . D PCETASK^ECPCEU(.EC2PCE) K EC2PCE
- Q ECERR
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECUTL2 7083 printed Jan 18, 2025@03:00:27 Page 2
- ECUTL2 ;ALB/JAM - Event Capture Diagnosis Code Selection ;23 Aug 2007
- +1 ;;2.0;EVENT CAPTURE;**23,33,47,63,72,95,114**;8 May 96;Build 20
- +2 ;
- +3 ; Reference to $$SINFO^ICDEX supported by ICR #5747
- +4 ; Reference to $$ICDDX^ICDEX supported by ICR5747
- +5 ;
- DIAG ;ask dx question (primary and multiple secondary)
- +1 ;check for primary dx and display message
- +2 DO PDXMSG
- +3 ;ask for primary dx
- +4 DO PDX
- IF ECOUT
- QUIT
- +5 ;ask for secondary dx
- +6 DO SDX
- IF ECOUT
- QUIT
- +7 IF $DATA(DTOUT)!$DATA(DUOUT)
- if $PIECE(ECPCE,"~",2)'="N"
- WRITE !!,"Please note that this record cannot be sent to PCE without a diagnosis.",!!
- +8 QUIT
- PDXMSG ; Check for existence of primary diagnoses and display message
- +1 NEW TXT,ECPDX
- +2 SET (ECDX,ECDXN,ECDXO)=""
- KILL ECDXS
- +3 ;Check if primary dx exist in file #721
- +4 SET ECPDX=$$PDXCK(ECDFN,ECDT,ECL,EC4)
- +5 IF +ECPDX
- WRITE !
- Begin DoDot:1
- +6 WRITE !?5,"WARNING: Primary Diagnoses already on File for this encounter."
- +7 WRITE !?5,"If changed, all procedures will be updated. ("_ECDXN_")"
- +8 SET ECDXO=ECDX
- End DoDot:1
- +9 IF $PIECE(ECPDX,U,2)
- Begin DoDot:1
- +10 SET TXT="WARNING: Primary diagnoses already sent to PCE. If changed,"
- +11 SET TXT=TXT_" all procedures"
- +12 WRITE !!?5,TXT
- +13 SET TXT="associated with this encounter will be updated and resent "
- +14 SET TXT=TXT_"to PCE."
- +15 WRITE !?5,TXT
- End DoDot:1
- +16 QUIT
- PDXCK(ECDFN,ECDTX,ECLX,EC4X) ;Get primary dx frm file #721 for pat encounter
- +1 ; Input: ECDFN = Patient ien
- +2 ; ECDTX = Date/time of procedure
- +3 ; ECLX = Location ien
- +4 ; EC4X = Clinic ien
- +5 ;
- +6 ; Output: PDXF^PCEF = primary dx flag (1/0)^dx sent to PCE flag (1/0)
- +7 ; ECDX = Primary diagnoses ien
- +8 ; ECDXN = Primary diagnoses code
- +9 ; ECDXIEN = Array of encounter IENs w primary dx
- +10 ;
- +11 NEW PDXF,PCEF,DA,DXIEN,DXS,DXN,ECCS
- +12 SET (PDXF,PCEF)=0
- SET DA=""
- KILL ECDXIEN
- +13 IF $GET(ECDFN)=""!($GET(ECDTX)="")!($GET(ECLX)="")!($GET(EC4X)="")
- QUIT PDXF_U_PCEF
- +14 IF $ORDER(^ECH("APAT",ECDFN,ECDTX,""))=""
- QUIT PDXF_U_PCEF
- +15 FOR
- SET DA=$ORDER(^ECH("APAT",ECDFN,ECDTX,DA))
- if DA=""
- QUIT
- Begin DoDot:1
- +16 IF EC4X'=$PIECE($GET(^ECH(DA,0)),U,19)
- QUIT
- +17 SET ECDX=$PIECE($GET(^ECH(DA,"P")),U,2)
- IF ECDX=""
- QUIT
- +18 ; Determine Active Coding System Based on Date of Interest
- +19 ; Supported by ICR 5747
- SET ECCS=$$SINFO^ICDEX("DIAG",ECDTX)
- +20 ; Retrieve ICD info - Supported by ICR 5747
- +21 SET ECDXN=$PIECE($$ICDDX^ICDEX(ECDX,ECDTX,+ECCS,"I"),U,2)
- +22 SET ECDXIEN(DA)=ECDXN_U_ECDX
- SET PDXF=1
- +23 IF $DATA(^ECH(DA,"SEND"))
- IF ^("SEND")=""
- SET PCEF=1
- +24 IF $DATA(^ECH(DA,"DX"))
- Begin DoDot:2
- +25 SET DXS=0
- FOR
- SET DXS=$ORDER(^ECH(DA,"DX",DXS))
- if 'DXS
- QUIT
- Begin DoDot:3
- +26 SET DXIEN=$PIECE($GET(^ECH(DA,"DX",DXS,0)),U)
- +27 ; Retrieve ICD info - Supported by ICR 5747
- +28 SET DXN=$PIECE($$ICDDX^ICDEX(DXIEN,ECDTX,+ECCS,"I"),U,2)
- if DXN'=""
- SET ECDXS(DXN)=DXIEN
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +29 QUIT PDXF_U_PCEF
- PDX ;Ask primary diagnoses code
- +1 ; Variables: ECDX = Primary diagnoses ien
- +2 ; ECDXN = Primary diagnoses code, default if define
- +3 ; ECOUT = Error flag (1/0)
- +4 ;
- +5 NEW DIC,X,Y,DTOUT,DUOUT,DEFX,ECODE,PROMPT,ECCS
- +6 SET ECDX=$GET(ECDX)
- SET ECDXN=$GET(ECDXN)
- SET PROMPT="Primary ICD Code: "
- +7 if ECDXN'=""
- SET DEFX=ECDXN
- +8 FOR
- DO LEX
- if $GET(ECOUT)
- QUIT
- Begin DoDot:1
- +9 IF X=""
- WRITE !,"This is a required response. Enter '^' to exit"
- QUIT
- +10 SET ECDXN=ECODE
- +11 ; Supported by ICR 5747
- SET ECCS=$$SINFO^ICDEX("DIAG",$GET(ECDT))
- +12 ; Supported by ICR 5747
- SET ECDX=$$ICDDX^ICDEX(ECODE,$GET(ECDT),+ECCS,"E")
- End DoDot:1
- IF $DATA(ECODE)
- QUIT
- +13 QUIT
- SDX ;Ask secondary diagnoses code
- +1 ; Variables: ECDX = Primary diagnoses ien, default if define
- +2 ; ECDXN = Primary diagnoses code
- +3 ; ECOUT = Error flag (1/0)
- +4 ; ECDXS = Array with secondary diagnosis code
- +5 ; subscript=dx code and set equal to dx ien
- +6 ;
- +7 NEW Y,X,DEFX,DIC,DTOUT,DUOUT,ECODE,ECCS
- +8 SET ECOUT=$GET(ECOUT)
- SET PROMPT="Secondary ICD Code: "
- +9 FOR
- DO LSTDXS
- DO LEX
- if Y<0
- QUIT
- Begin DoDot:1
- +10 IF ECODE=""
- QUIT
- +11 IF ECODE=$GET(ECDXN)
- WRITE " Already exist as primary dx."
- QUIT
- +12 IF $DATA(ECDXS(ECODE))
- DO DELDUP
- QUIT
- +13 ; Determine Active Coding System Based on Date of Interest
- +14 ; Supported by ICR 5747
- SET ECCS=$$SINFO^ICDEX("DIAG",$GET(ECDT))
- +15 ; Supported by ICR 5747
- SET ECDXS(ECODE)=+$$ICDDX^ICDEX(ECODE,$GET(ECDT),+ECCS,"E")
- End DoDot:1
- IF ECOUT
- QUIT
- +16 QUIT
- DELDUP ;Delete secondary diagnosis code from list
- +1 NEW DIR,DIRUT,DTOUT,DUOUT,DIROUT
- +2 SET DIR("A")="Delete "_ECODE_" Code from List"
- +3 SET DIR(0)="Y"
- +4 DO ^DIR
- +5 IF $DATA(DIRUT)!($DATA(DIROUT))
- SET ECOUT=1
- QUIT
- +6 IF Y
- KILL ECDXS(ECODE)
- +7 QUIT
- +8 ;
- LEX ;ICD code from LEX database
- +1 ;K X,Y
- +2 NEW IMP,APP,ECX
- +3 SET (ECX,X)=$GET(DEFX)
- +4 ;LEX DBIA1577
- +5 ; Supported by ICR 5679
- SET IMP=$$IMPDATE^LEXU("10D")
- SET APP=$SELECT(ECDT<IMP:"ICD",1:"10D")
- +6 DO CONFIG^LEXSET(APP,APP,$GET(ECDT))
- +7 ;LEX DBIA2950
- DO LOOK^LEXA(ECX,APP,1,"",ECDT)
- +8 SET DIC="757.01"
- SET DIC(0)=$SELECT('$LENGTH($GET(X)):"A",1:"")_"EQM"
- SET DIC("A")=PROMPT
- +9 DO ^DIC
- +10 IF $DATA(DTOUT)!$DATA(DUOUT)
- SET ECOUT=1
- QUIT
- +11 IF X=""
- QUIT
- +12 IF Y<0
- SET ECOUT=1
- QUIT
- +13 SET ECODE=$GET(Y(1))
- +14 QUIT
- +15 ;
- LSTDXS ;list ICD code
- +1 NEW DXS,ECCS
- +2 IF $DATA(ECDXS)
- Begin DoDot:1
- +3 WRITE !?1,"Secondary ICD code entered:"
- +4 SET DXS=""
- +5 FOR
- SET DXS=$ORDER(ECDXS(DXS))
- if DXS=""
- QUIT
- Begin DoDot:2
- +6 ; Determine Active Coding System Based on Date of Interest
- +7 ; Supported by ICR 5747
- SET ECCS=$$SINFO^ICDEX("DIAG",$GET(ECDT))
- +8 ; Supported by ICR 5747
- WRITE !,?4,DXS,?15,$PIECE($$ICDDX^ICDEX(DXS,$GET(ECDT),+ECCS,"E"),"^",4)
- End DoDot:2
- End DoDot:1
- +9 QUIT
- PXUPD(ECDFN,ECDT,ECL,EC4,ECDXP,ECDXX,ECXIEN) ; Update all associated
- +1 ; procedures for an EC Patient encounter with the same primary and
- +2 ; secondary dx codes
- +3 ;
- +4 ; Input: ECDFN = Patient ien
- +5 ; ECDT = Date/time of procedure
- +6 ; ECL = Location ien
- +7 ; EC4 = Clinic ien
- +8 ; ECDXP = Primary diagnoses code
- +9 ; ECDXX = Array of secondary diagnoses codes
- +10 ; ECXIEN = 721 ien, if define don't process
- +11 ;
- +12 ; Output: ECERR 0 - Process completed
- +13 ;
- +14 NEW ECIEN,ECERR,DIE,DR,DA,DTOUT,DIROUT,ECDXIEN,ECPDX,ECDX,ECDXN,DIC,X
- +15 NEW ECVST,ECVAR1,VALQUIET,DXN,DXSIEN,DIK,ECDXS
- +16 SET ECERR=0
- +17 IF $DATA(ECDXP)=""
- QUIT ECERR
- +18 SET ECPDX=$$PDXCK(ECDFN,ECDT,ECL,EC4)
- +19 IF '$DATA(ECDXIEN)
- QUIT ECERR
- +20 SET ECIEN=""
- SET DIE="^ECH("
- +21 FOR
- SET ECIEN=$ORDER(ECDXIEN(ECIEN))
- if ECIEN=""
- QUIT
- Begin DoDot:1
- +22 IF $GET(ECXIEN)'=""
- IF ECXIEN=ECIEN
- QUIT
- +23 SET ECNODE=$GET(^ECH(ECIEN,"P"))
- IF ECNODE=""
- QUIT
- +24 IF ECDXP'=$PIECE(ECNODE,U,2)
- Begin DoDot:2
- +25 SET DA=ECIEN
- SET DR="20////"_ECDXP
- DO ^DIE
- +26 SET $PIECE(^ECH(ECIEN,"PCE"),"~",11)=ECDXP
- End DoDot:2
- +27 ;delete all secondary diagnosis codes
- +28 SET DA(1)=ECIEN
- SET DIK="^ECH("_DA(1)_",""DX"","
- SET DA=0
- +29 FOR
- SET DA=$ORDER(^ECH(ECIEN,"DX",DA))
- if 'DA
- QUIT
- DO ^DIK
- +30 IF $DATA(^ECH(ECIEN,"DX"))
- KILL ^ECH(ECIEN,"DX")
- +31 ;update secondary diagnosis codes on procedure
- +32 SET DXN=""
- FOR
- SET DXN=$ORDER(ECDXX(DXN))
- if DXN=""
- QUIT
- Begin DoDot:2
- +33 SET DXSIEN=$PIECE(ECDXX(DXN),U)
- IF DXSIEN<0
- QUIT
- +34 KILL DIC,DD,DO
- SET DIC(0)="L"
- SET DA(1)=ECIEN
- SET DIC("P")=$PIECE(^DD(721,38,0),U,2)
- +35 SET X=DXSIEN
- SET DIC="^ECH("_DA(1)_","_"""DX"""_","
- DO FILE^DICN
- End DoDot:2
- +36 ;delete visit and resend to PCE
- +37 SET ECVST=+$PIECE($GET(^ECH(ECIEN,0)),"^",21)
- IF 'ECVST
- QUIT
- +38 ;* Prepare all EC records with same Visit file entry to resend to PCE
- +39 KILL EC2PCE
- SET ECVAR1=$$FNDVST^ECUTL(ECVST,,.EC2PCE)
- +40 ;- Set VALQUIET to stop Amb Care validator from broadcasting to screen
- +41 NEW ECPKG,ECSOU
- +42 SET ECPKG=$ORDER(^DIC(9.4,"B","EVENT CAPTURE",0))
- SET ECSOU="EVENT CAPTURE DATA"
- +43 SET VALQUIET=1
- SET ECVV=$$DELVFILE^PXAPI("ALL",ECVST,ECPKG,ECSOU)
- +44 ;- Send to PCE task
- +45 DO PCETASK^ECPCEU(.EC2PCE)
- KILL EC2PCE
- End DoDot:1
- +46 QUIT ECERR