- ECPCEU ;BIR/JPW-ECS to PCE Utilities ;7 Jan 97
- ;;2.0; EVENT CAPTURE ;**4,5,7,10,17,18,23,42,54,73,72,95,76**;8 May 96;Build 6
- CLIN ;check for active inactive clinic
- N ECCLDT
- I $L($G(ECDT))>6,+ECDT=ECDT S ECCLDT=ECDT
- I '$G(ECCLDT) S ECCLDT=DT
- K ECPCL
- I '$D(EC4) S ECPCL=0 Q
- I 'EC4 S ECPCL=0 Q
- I '$D(^SC(+EC4,"I")) S ECPCL=1 Q
- S ECPCID=+$P(^SC(+EC4,"I"),"^"),ECPCRD=+$P(^("I"),"^",2)
- I ECPCID,ECPCID'>ECCLDT I 'ECPCRD!(ECPCRD>ECCLDT) S ECPCL=0 Q
- I ECPCID,ECPCRD,ECPCRD'>ECCLDT S ECPCL=1 Q
- I ECPCID,ECPCID>ECCLDT S ECPCL=1 Q
- S ECPCL=1
- K ECPCID,ECPCRD
- Q
- NITE ;start nightly job
- K ^TMP("ECPXAPI",$J)
- D NOW^%DTC S ECCKDT=+$E(%,1,12)
- S ECPKG=$O(^DIC(9.4,"B","EVENT CAPTURE",0)),ECS="EVENT CAPTURE DATA"
- S ECJJ=0 F S ECJJ=$O(^ECH("AD",ECJJ)) Q:'ECJJ S ECJJ1=0 F S ECJJ1=$O(^ECH("AD",ECJJ,ECJJ1)) Q:'ECJJ1 I $D(^ECH(ECJJ1,"PCE")) D SET
- K DA,DIE,DR,EC4,EC725,ECAO,ECCPT,ECDT,ECDX,ECHL,ECID,ECIR,ECJJ,ECJJ1,ECL,ECNODE,ECPKG,ECPS,ECS,ECSC,ECV,ECVST,ECVV,ECZEC,ECMST,ECHNC,ECCV,ECSHAD,ECDFAPT,CNT,ECPRVARY,ECPRV,ECUSR
- K %,%H,%I,ECCKDT
- K ^TMP("ECPXAPI",$J)
- Q
- SET ;set variables
- S ECNODE=^ECH(ECJJ1,"PCE"),ECDT=$P(ECNODE,"~"),ECPS=$P(ECNODE,"~",2),ECHL=$P(ECNODE,"~",3),ECL=$P(ECNODE,"~",4),ECID=$P(ECNODE,"~",5),ECV=$P(ECNODE,"~",9),ECUSR=$P($G(^ECH(ECJJ1,0)),U,13)
- S ECCPT=$P(ECNODE,"~",10),ECDX=$P(ECNODE,"~",11),ECAO=$P(ECNODE,"~",12),ECIR=$P(ECNODE,"~",13),ECZEC=$P(ECNODE,"~",14),ECSC=$P(ECNODE,"~",15),EC725=$P(ECNODE,"~",16),ECELIG=$P(ECNODE,"~",17),ECMST=$P(ECNODE,"~",18)
- S ECHNC=$P(ECNODE,"~",19),ECCV=$P(ECNODE,"~",20),ECSHAD=$P(ECNODE,"~",21)
- ; EC*2.0*73 next line added to get default appt type if defined
- S ECDFAPT="" S:$D(^SC(ECHL,"AT")) ECDFAPT=+$G(^SC(ECHL,"AT"))
- TMP ;set ^TMP for PCE call
- ENC S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"ENC D/T")=ECDT
- S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"PATIENT")=ECPS
- S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"HOS LOC")=ECHL
- S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"INSTITUTION")=ECL
- S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"APPT")=ECDFAPT ; added EC*2.0*73
- S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"SC")=ECSC
- S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"AO")=ECAO
- S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"IR")=ECIR
- S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"EC")=ECZEC
- S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"MST")=ECMST
- S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"HNC")=ECHNC
- S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"CV")=ECCV
- S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"SHAD")=ECSHAD
- S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"SERVICE CATEGORY")="X"
- S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"ENCOUNTER TYPE")="A"
- S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"DSS ID")=ECID
- S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"CHECKOUT D/T")=ECCKDT
- S ^TMP("ECPXAPI",$J,"ENCOUNTER",1,"ELIGIBILITY")=ECELIG
- PROV ;Set providers in ^TMP("ECPXAPI",$J,"PROVIDER",n,"NAME")=provider
- K ECPRVARY S ECPRV=$$GETPRV^ECPRVMUT(ECJJ1,.ECPRVARY),ECI=0
- ;set primary provider in ^TMP global
- F S ECI=$O(ECPRVARY(ECI)) Q:'ECI I $P(ECPRVARY(ECI),U,3)="P" D Q
- .S ^TMP("ECPXAPI",$J,"PROVIDER",1,"NAME")=$P(ECPRVARY(ECI),U)
- .S ^TMP("ECPXAPI",$J,"PROVIDER",1,"PRIMARY")=1
- .S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"ENC PROVIDER")=$P(ECPRVARY(ECI),U)
- .K ECPRVARY(ECI)
- ;set secondary providers in ^TMP global
- S ECI=0,CNT=2 F S ECI=$O(ECPRVARY(ECI)) Q:'ECI D
- .S ^TMP("ECPXAPI",$J,"PROVIDER",CNT,"NAME")=$P(ECPRVARY(ECI),U),CNT=CNT+1
- I $O(^ECH(ECJJ1,"MOD",0))'="" S ECMODF=$$MOD^ECUTL(ECJJ1,"E",.ECMOD) D
- . I ECMODF S MOD="" F S MOD=$O(ECMOD(MOD)) Q:MOD="" D
- . . S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"MODIFIERS",MOD)=""
- DX S ^TMP("ECPXAPI",$J,"DX/PL",1,"DIAGNOSIS")=ECDX
- S ^TMP("ECPXAPI",$J,"DX/PL",1,"PRIMARY")=1
- ;Set secondary diagnosis codes in ^TMP("ECPXAPI",$J,"DX/PL",1,"DIAGNOSIS",diagnosis
- S DXS=0 F ECI=2:1 S DXS=$O(^ECH(ECJJ1,"DX",DXS)) Q:DXS="" D
- . S DXSIEN=$G(^ECH(ECJJ1,"DX",DXS,0)) I DXSIEN="" Q
- . S ^TMP("ECPXAPI",$J,"DX/PL",ECI,"DIAGNOSIS")=DXSIEN
- PROC S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"EVENT D/T")=ECDT
- S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"PROCEDURE")=ECCPT
- S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"QTY")=ECV
- S:EC725]"" ^TMP("ECPXAPI",$J,"PROCEDURE",1,"NARRATIVE")=EC725
- MOD ;Set modifiers in ^TMP("ECPXAPI",$J,"PROCEDURE",1,"MODIFIERS",modifier
- I $O(^ECH(ECJJ1,"MOD",0))'="" S ECMODF=$$MOD^ECUTL(ECJJ1,"E",.ECMOD) D
- . I ECMODF S MOD="" F S MOD=$O(ECMOD(MOD)) Q:MOD="" D
- . . S ^TMP("ECPXAPI",$J,"PROCEDURE",1,"MODIFIERS",MOD)=""
- D2PCE S VALQUIET=1,ECVV=$$DATA2PCE^PXAPI("^TMP(""ECPXAPI"",$J)",ECPKG,ECS,.ECVST,ECUSR)
- I ECVST K DA,DIE,DR S DA=ECJJ1,DIE=721,DR="25////1;31///@;28////"_ECVST_";32////"_ECCKDT D ^DIE K DA,DIE,DR
- K ^TMP("ECPXAPI",$J),ECVST,VALQUIET,MOD,ECMODF,ECMOD,ECI,DXSIEN,DXS
- K DA,D0,DIE,DR,EC725,ECAO,ECCPT,ECDT,ECDX,ECHL,ECID,ECIR,ECNODE,ECPS,ECSC,ECV,ECVV,ECZEC,ECELIG,ECMST,ECHNC,ECCV,ECSHAD,CNT,ECPRVARY,ECPRV
- Q
- ;
- PCETASK(ECPCE) ;Set up task for transfer to PCE
- ;
- ; Input:
- ; ECPCE - [pass by reference] array subscripted by FM date/time
- ; and pointer to EVENT CAPTURE PATIENT (#721) file
- ; [ex: ECPCE(3080101.140425,611)]
- ;
- ; Output:
- ; Function value - Task ID on success; 0 on failure
- ;
- N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
- S ZTIO=""
- S ZTRTN="XFER2PCE^ECPCEU"
- S ZTDESC="ECS2PCE TRANSFER"
- S ZTDTH=$$NOW^XLFDT()
- S ZTSAVE("ECPCE(")=""
- D ^%ZTLOAD
- Q $S($D(ZTSK):ZTSK,1:0)
- ;
- XFER2PCE ;Task entry point for single ECS record xfer to PCE
- ;Input from Task: ECPCE -array subscripted by date and pointer
- ; to EVENT CAPTURE PATIENT (#721) file
- ; [Ex: ECPCE(3080101,611)]
- ;
- N ECPKG ;package name
- N ECS ;source
- N ECCKDT ;check-out date/time
- N ECJJ ;date iterator
- N ECJJ1 ;file #721 IEN iterator
- K ^TMP("ECPXAPI",$J)
- D NOW^%DTC S ECCKDT=+$E(%,1,12)
- S ECPKG=$O(^DIC(9.4,"B","EVENT CAPTURE",0)),ECS="EVENT CAPTURE DATA"
- S ECJJ=0 F S ECJJ=$O(ECPCE(ECJJ)) Q:'ECJJ D
- . S ECJJ1=0
- . F S ECJJ1=$O(ECPCE(ECJJ,ECJJ1)) Q:'ECJJ1 D
- . . I $D(^ECH(ECJJ1,"PCE")) D SET
- K DA,DIE,DR,EC4,EC725,ECAO,ECCPT,ECDT,ECDX,ECHL,ECID,ECIR,ECJJ,ECJJ1,ECL,ECNODE,ECPKG,ECPS,ECS,ECSC,ECV,ECVST,ECVV,ECZEC,ECMST,ECHNC,ECCV,ECDFAPT,CNT,ECPRVARY,ECPRV,ECUSR
- K %,%H,%I,ECCKDT
- K ^TMP("ECPXAPI",$J)
- S ZTREQ="@"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECPCEU 6223 printed Jan 18, 2025@02:59:35 Page 2
- ECPCEU ;BIR/JPW-ECS to PCE Utilities ;7 Jan 97
- +1 ;;2.0; EVENT CAPTURE ;**4,5,7,10,17,18,23,42,54,73,72,95,76**;8 May 96;Build 6
- CLIN ;check for active inactive clinic
- +1 NEW ECCLDT
- +2 IF $LENGTH($GET(ECDT))>6
- IF +ECDT=ECDT
- SET ECCLDT=ECDT
- +3 IF '$GET(ECCLDT)
- SET ECCLDT=DT
- +4 KILL ECPCL
- +5 IF '$DATA(EC4)
- SET ECPCL=0
- QUIT
- +6 IF 'EC4
- SET ECPCL=0
- QUIT
- +7 IF '$DATA(^SC(+EC4,"I"))
- SET ECPCL=1
- QUIT
- +8 SET ECPCID=+$PIECE(^SC(+EC4,"I"),"^")
- SET ECPCRD=+$PIECE(^("I"),"^",2)
- +9 IF ECPCID
- IF ECPCID'>ECCLDT
- IF 'ECPCRD!(ECPCRD>ECCLDT)
- SET ECPCL=0
- QUIT
- +10 IF ECPCID
- IF ECPCRD
- IF ECPCRD'>ECCLDT
- SET ECPCL=1
- QUIT
- +11 IF ECPCID
- IF ECPCID>ECCLDT
- SET ECPCL=1
- QUIT
- +12 SET ECPCL=1
- +13 KILL ECPCID,ECPCRD
- +14 QUIT
- NITE ;start nightly job
- +1 KILL ^TMP("ECPXAPI",$JOB)
- +2 DO NOW^%DTC
- SET ECCKDT=+$EXTRACT(%,1,12)
- +3 SET ECPKG=$ORDER(^DIC(9.4,"B","EVENT CAPTURE",0))
- SET ECS="EVENT CAPTURE DATA"
- +4 SET ECJJ=0
- FOR
- SET ECJJ=$ORDER(^ECH("AD",ECJJ))
- if 'ECJJ
- QUIT
- SET ECJJ1=0
- FOR
- SET ECJJ1=$ORDER(^ECH("AD",ECJJ,ECJJ1))
- if 'ECJJ1
- QUIT
- IF $DATA(^ECH(ECJJ1,"PCE"))
- DO SET
- +5 KILL DA,DIE,DR,EC4,EC725,ECAO,ECCPT,ECDT,ECDX,ECHL,ECID,ECIR,ECJJ,ECJJ1,ECL,ECNODE,ECPKG,ECPS,ECS,ECSC,ECV,ECVST,ECVV,ECZEC,ECMST,ECHNC,ECCV,ECSHAD,ECDFAPT,CNT,ECPRVARY,ECPRV,ECUSR
- +6 KILL %,%H,%I,ECCKDT
- +7 KILL ^TMP("ECPXAPI",$JOB)
- +8 QUIT
- SET ;set variables
- +1 SET ECNODE=^ECH(ECJJ1,"PCE")
- SET ECDT=$PIECE(ECNODE,"~")
- SET ECPS=$PIECE(ECNODE,"~",2)
- SET ECHL=$PIECE(ECNODE,"~",3)
- SET ECL=$PIECE(ECNODE,"~",4)
- SET ECID=$PIECE(ECNODE,"~",5)
- SET ECV=$PIECE(ECNODE,"~",9)
- SET ECUSR=$PIECE($GET(^ECH(ECJJ1,0)),U,13)
- +2 SET ECCPT=$PIECE(ECNODE,"~",10)
- SET ECDX=$PIECE(ECNODE,"~",11)
- SET ECAO=$PIECE(ECNODE,"~",12)
- SET ECIR=$PIECE(ECNODE,"~",13)
- SET ECZEC=$PIECE(ECNODE,"~",14)
- SET ECSC=$PIECE(ECNODE,"~",15)
- SET EC725=$PIECE(ECNODE,"~",16)
- SET ECELIG=$PIECE(ECNODE,"~",17)
- SET ECMST=$PIECE(ECNODE,"~",18)
- +3 SET ECHNC=$PIECE(ECNODE,"~",19)
- SET ECCV=$PIECE(ECNODE,"~",20)
- SET ECSHAD=$PIECE(ECNODE,"~",21)
- +4 ; EC*2.0*73 next line added to get default appt type if defined
- +5 SET ECDFAPT=""
- if $DATA(^SC(ECHL,"AT"))
- SET ECDFAPT=+$GET(^SC(ECHL,"AT"))
- TMP ;set ^TMP for PCE call
- ENC SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"ENC D/T")=ECDT
- +1 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"PATIENT")=ECPS
- +2 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"HOS LOC")=ECHL
- +3 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"INSTITUTION")=ECL
- +4 ; added EC*2.0*73
- SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"APPT")=ECDFAPT
- +5 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"SC")=ECSC
- +6 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"AO")=ECAO
- +7 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"IR")=ECIR
- +8 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"EC")=ECZEC
- +9 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"MST")=ECMST
- +10 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"HNC")=ECHNC
- +11 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"CV")=ECCV
- +12 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"SHAD")=ECSHAD
- +13 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"SERVICE CATEGORY")="X"
- +14 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"ENCOUNTER TYPE")="A"
- +15 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"DSS ID")=ECID
- +16 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"CHECKOUT D/T")=ECCKDT
- +17 SET ^TMP("ECPXAPI",$JOB,"ENCOUNTER",1,"ELIGIBILITY")=ECELIG
- PROV ;Set providers in ^TMP("ECPXAPI",$J,"PROVIDER",n,"NAME")=provider
- +1 KILL ECPRVARY
- SET ECPRV=$$GETPRV^ECPRVMUT(ECJJ1,.ECPRVARY)
- SET ECI=0
- +2 ;set primary provider in ^TMP global
- +3 FOR
- SET ECI=$ORDER(ECPRVARY(ECI))
- if 'ECI
- QUIT
- IF $PIECE(ECPRVARY(ECI),U,3)="P"
- Begin DoDot:1
- +4 SET ^TMP("ECPXAPI",$JOB,"PROVIDER",1,"NAME")=$PIECE(ECPRVARY(ECI),U)
- +5 SET ^TMP("ECPXAPI",$JOB,"PROVIDER",1,"PRIMARY")=1
- +6 SET ^TMP("ECPXAPI",$JOB,"PROCEDURE",1,"ENC PROVIDER")=$PIECE(ECPRVARY(ECI),U)
- +7 KILL ECPRVARY(ECI)
- End DoDot:1
- QUIT
- +8 ;set secondary providers in ^TMP global
- +9 SET ECI=0
- SET CNT=2
- FOR
- SET ECI=$ORDER(ECPRVARY(ECI))
- if 'ECI
- QUIT
- Begin DoDot:1
- +10 SET ^TMP("ECPXAPI",$JOB,"PROVIDER",CNT,"NAME")=$PIECE(ECPRVARY(ECI),U)
- SET CNT=CNT+1
- End DoDot:1
- +11 IF $ORDER(^ECH(ECJJ1,"MOD",0))'=""
- SET ECMODF=$$MOD^ECUTL(ECJJ1,"E",.ECMOD)
- Begin DoDot:1
- +12 IF ECMODF
- SET MOD=""
- FOR
- SET MOD=$ORDER(ECMOD(MOD))
- if MOD=""
- QUIT
- Begin DoDot:2
- +13 SET ^TMP("ECPXAPI",$JOB,"PROCEDURE",1,"MODIFIERS",MOD)=""
- End DoDot:2
- End DoDot:1
- DX SET ^TMP("ECPXAPI",$JOB,"DX/PL",1,"DIAGNOSIS")=ECDX
- +1 SET ^TMP("ECPXAPI",$JOB,"DX/PL",1,"PRIMARY")=1
- +2 ;Set secondary diagnosis codes in ^TMP("ECPXAPI",$J,"DX/PL",1,"DIAGNOSIS",diagnosis
- +3 SET DXS=0
- FOR ECI=2:1
- SET DXS=$ORDER(^ECH(ECJJ1,"DX",DXS))
- if DXS=""
- QUIT
- Begin DoDot:1
- +4 SET DXSIEN=$GET(^ECH(ECJJ1,"DX",DXS,0))
- IF DXSIEN=""
- QUIT
- +5 SET ^TMP("ECPXAPI",$JOB,"DX/PL",ECI,"DIAGNOSIS")=DXSIEN
- End DoDot:1
- PROC SET ^TMP("ECPXAPI",$JOB,"PROCEDURE",1,"EVENT D/T")=ECDT
- +1 SET ^TMP("ECPXAPI",$JOB,"PROCEDURE",1,"PROCEDURE")=ECCPT
- +2 SET ^TMP("ECPXAPI",$JOB,"PROCEDURE",1,"QTY")=ECV
- +3 if EC725]""
- SET ^TMP("ECPXAPI",$JOB,"PROCEDURE",1,"NARRATIVE")=EC725
- MOD ;Set modifiers in ^TMP("ECPXAPI",$J,"PROCEDURE",1,"MODIFIERS",modifier
- +1 IF $ORDER(^ECH(ECJJ1,"MOD",0))'=""
- SET ECMODF=$$MOD^ECUTL(ECJJ1,"E",.ECMOD)
- Begin DoDot:1
- +2 IF ECMODF
- SET MOD=""
- FOR
- SET MOD=$ORDER(ECMOD(MOD))
- if MOD=""
- QUIT
- Begin DoDot:2
- +3 SET ^TMP("ECPXAPI",$JOB,"PROCEDURE",1,"MODIFIERS",MOD)=""
- End DoDot:2
- End DoDot:1
- D2PCE SET VALQUIET=1
- SET ECVV=$$DATA2PCE^PXAPI("^TMP(""ECPXAPI"",$J)",ECPKG,ECS,.ECVST,ECUSR)
- +1 IF ECVST
- KILL DA,DIE,DR
- SET DA=ECJJ1
- SET DIE=721
- SET DR="25////1;31///@;28////"_ECVST_";32////"_ECCKDT
- DO ^DIE
- KILL DA,DIE,DR
- +2 KILL ^TMP("ECPXAPI",$JOB),ECVST,VALQUIET,MOD,ECMODF,ECMOD,ECI,DXSIEN,DXS
- +3 KILL DA,D0,DIE,DR,EC725,ECAO,ECCPT,ECDT,ECDX,ECHL,ECID,ECIR,ECNODE,ECPS,ECSC,ECV,ECVV,ECZEC,ECELIG,ECMST,ECHNC,ECCV,ECSHAD,CNT,ECPRVARY,ECPRV
- +4 QUIT
- +5 ;
- PCETASK(ECPCE) ;Set up task for transfer to PCE
- +1 ;
- +2 ; Input:
- +3 ; ECPCE - [pass by reference] array subscripted by FM date/time
- +4 ; and pointer to EVENT CAPTURE PATIENT (#721) file
- +5 ; [ex: ECPCE(3080101.140425,611)]
- +6 ;
- +7 ; Output:
- +8 ; Function value - Task ID on success; 0 on failure
- +9 ;
- +10 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
- +11 SET ZTIO=""
- +12 SET ZTRTN="XFER2PCE^ECPCEU"
- +13 SET ZTDESC="ECS2PCE TRANSFER"
- +14 SET ZTDTH=$$NOW^XLFDT()
- +15 SET ZTSAVE("ECPCE(")=""
- +16 DO ^%ZTLOAD
- +17 QUIT $SELECT($DATA(ZTSK):ZTSK,1:0)
- +18 ;
- XFER2PCE ;Task entry point for single ECS record xfer to PCE
- +1 ;Input from Task: ECPCE -array subscripted by date and pointer
- +2 ; to EVENT CAPTURE PATIENT (#721) file
- +3 ; [Ex: ECPCE(3080101,611)]
- +4 ;
- +5 ;package name
- NEW ECPKG
- +6 ;source
- NEW ECS
- +7 ;check-out date/time
- NEW ECCKDT
- +8 ;date iterator
- NEW ECJJ
- +9 ;file #721 IEN iterator
- NEW ECJJ1
- +10 KILL ^TMP("ECPXAPI",$JOB)
- +11 DO NOW^%DTC
- SET ECCKDT=+$EXTRACT(%,1,12)
- +12 SET ECPKG=$ORDER(^DIC(9.4,"B","EVENT CAPTURE",0))
- SET ECS="EVENT CAPTURE DATA"
- +13 SET ECJJ=0
- FOR
- SET ECJJ=$ORDER(ECPCE(ECJJ))
- if 'ECJJ
- QUIT
- Begin DoDot:1
- +14 SET ECJJ1=0
- +15 FOR
- SET ECJJ1=$ORDER(ECPCE(ECJJ,ECJJ1))
- if 'ECJJ1
- QUIT
- Begin DoDot:2
- +16 IF $DATA(^ECH(ECJJ1,"PCE"))
- DO SET
- End DoDot:2
- End DoDot:1
- +17 KILL DA,DIE,DR,EC4,EC725,ECAO,ECCPT,ECDT,ECDX,ECHL,ECID,ECIR,ECJJ,ECJJ1,ECL,ECNODE,ECPKG,ECPS,ECS,ECSC,ECV,ECVST,ECVV,ECZEC,ECMST,ECHNC,ECCV,ECDFAPT,CNT,ECPRVARY,ECPRV,ECUSR
- +18 KILL %,%H,%I,ECCKDT
- +19 KILL ^TMP("ECPXAPI",$JOB)
- +20 SET ZTREQ="@"
- +21 QUIT