ECUTL ;ALB/GTS/JAM - Event Capture Utilities ;23 Jul 2008
;;2.0; EVENT CAPTURE ;**10,18,47,63,95**;8 May 96;Build 26
;
FNDVST(ECVST,ECRECNUM,EC2PCE) ; Search EC Patient records for associated Visits
;
; Input: ECVST - Visit file IEN to search for
; ECRECNUM - Event Capture record number to skip processing
; EC2PCE - Array passed by reference to contain results
;
; Output: ECERR 1 - One of the records to resend lacks a zero node
; 0 - All of the records to resend have zero nodes
; EC2PCE - array subscripted by date and pointer
; to EVENT CAPTURE PATIENT (#721) file
; [Ex: ECPCE(3080101,611)]
;
N ECIEN,ECERR,ECVAR
I '$D(ECRECNUM) S ECRECNUM=0
S (ECVAR,ECERR)=0
S:+ECVST'>0 ECERR=1
I ECERR=0 DO
.S ECIEN=""
.F S ECIEN=$O(^ECH("C",ECVST,ECIEN)) Q:+ECIEN=0 DO
..S:ECRECNUM'=ECIEN ECVAR=$$RSEND(ECIEN,.EC2PCE)
..S:ECVAR>0 ECERR=1
FNDVSTQ Q ECERR
;
RSEND(ECIEN,ECPCE) ; Prepare EC Patient record for resending to PCE
;
; Input: ECIEN - IEN for record to resend to PCE
; ECPCE - array passed by reference to contain results
; Output: 0 if successful - EC Patient record will be resent to PCE
; 1 if Unsuccessful - EC Patient record lacks zero node
; ECPCE - array subscripted by date and pointer
; to EVENT CAPTURE PATIENT (#721) file
; [Ex: ECPCE(3080101,611)]
;
N ECERR,DA,DIE,DR,ECPROCDT
S ECERR=0
I '$D(^ECH(ECIEN,0)) S ECERR=1
I ECERR=0 DO
.S ECPROCDT=$P(^ECH(ECIEN,0),"^",3)
.;remove set of field #31 and create ECPCE array to pass to
.;direct EC to PCE xfer task
.;S DA=ECIEN,DIE=721,DR="25///@;28///@;31///^S X=ECPROCDT;32///@"
.S DA=ECIEN,DIE=721,DR="25///@;28///@;32///@"
.D ^DIE
.S ECPCE(ECPROCDT,ECIEN)=""
RSENDQ Q ECERR
MODSCN() ;Screen CPT Procedure Modifier
N ECPT,ECCPT,ECPDT
S ECCPT="" I $G(ECP)'="" D
. S ECCPT=$S(ECP["EC":$P($G(^EC(725,+ECP,0)),"^",5),1:+ECP)
S ECPDT=$S($D(^ECH(DA,0)):$P(^ECH(DA,0),U,3),$D(ECDT):ECDT,1:"")
S ECPT=$S($D(^ECH(DA,"P")):$P(^ECH(DA,"P"),U),ECCPT'="":ECCPT,1:"")
I ECPT'="",+$$MODP^ICPTMOD(ECPT,+Y,"I",ECPDT)>0
Q
ASKMOD(PROC,MOD,PRDT,ECMOD,ECERR) ; Ask CPT modifiers for CPT procedure
; Input PROC = CPT Procedure
; MOD = Default modifier
; PRDT = Date/Time of procedure. Checks modifier status
;
;Output ECMOD( array with modifiers
; ECERR = Error flag 1 - error or 0 - no error.
;
N DTOUT,DUOUT,DIROUT,SUB,I,DEF,DIR,DIC,DSC,IEN,DATA,MODAR
S ECERR=$G(ECERR,0),DEF=""
I PROC="" S ECERR=1 G ASKMODQ
I '$D(PRDT) S PRDT=""
S DIC="^ICPT(",DIC(0)="N",X=PROC
S DIC("S")="I $P($$CPT^ICPTCOD(+Y,PRDT),""^"",7)"
D ^DIC I +Y=-1 S ECERR=1 G ASKMODQ
;If no modifiers present for CPT code quit
S DATA=$$CODM^ICPTCOD(PROC,"MODAR","",PRDT)
G:$O(MODAR(""))="" ASKMODQ K MODAR
;Set modifiers in ECMOD array if a valid pair (CPT code/modifier)
S SUB="" F I=1:1 S SUB=$P(MOD,",",I) Q:SUB="" D
. S DATA=$$MODP^ICPTMOD(PROC,SUB,"E",PRDT)
. I +DATA'>0 W !?2,"Modifier: ",SUB," Invalid - ",$P(DATA,U,2) Q
. S DSC=$P(DATA,U,2),IEN=$P(DATA,U),ECMOD(PROC,SUB)=DSC_U_IEN,DEF=SUB
;List modifiers entered
S SUB="" F I=1:1 S SUB=$O(ECMOD(PROC,SUB)) Q:SUB="" D
. W !?2,"Modifier: ",SUB," ",$P(ECMOD(PROC,SUB),U)
I DEF'="" S DIR("B")=DEF
AGAIN N Y,X,DEFX,ECY
S DIR("A")="Modifier",DIR("?")="^D MODHLP^ECUTL"
S DIR(0)="FO^^I $$VALMOD^ECUTL(PROC,X,PRDT)",DEFX=""
D ^DIR K DIR G:X="" ASKMODQ
I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) K ECMOD(PROC) S ECERR=1 G ASKMODQ
D G AGAIN
. I X="@" K:DEF'="" ECMOD(PROC,DEF) W " ...deleted" Q
. I '$D(ECY) Q
. I DEF'=DEFX,DEFX'="",$D(ECMOD(PROC,DEFX)) S (DEF,DIR("B"))=DEFX Q
. K DIR("B") S ECMOD(PROC,$P(ECY,U,2))=$P(ECY(0),U,2)_U_$P(ECY,U),DEF=""
;
ASKMODQ Q $S(ECERR:0,1:1)
;
VALMOD(PROC,X,PRDT) ;Validate modifiers
N DIC,DTOUT,DUOUT,DIROUT,DUOUT
S DIC="^DIC(81.3,",DIC(0)="MEQZ"
S DIC("W")="W "" "" W "" "",$P($$MOD^ICPTMOD(+Y,""I"",$G(PRDT)),U,3)"
S DIC("S")="I +$$MODP^ICPTMOD(PROC,Y,""I"",PRDT)>0"
D ^DIC I Y<0 K X Q 1
M ECY=Y S DEFX=$P(Y,U,2)
Q 1
MODHLP ;Help for CPT modifiers
N DIC,MOD,D
Q:'$D(PROC) I $D(ECMOD(PROC)) D
. W !?2,"Answer with CPT MODIFIER",!?1,"Choose from:"
. S MOD="" F S MOD=$O(ECMOD(PROC,MOD)) Q:MOD="" W !,?4,MOD
W !?6,"You may enter a new CPT MODIFIER, if you wish"
W !?6,"Enter a modifier that is valid for the CPT procedure code."
S DIC="^DIC(81.3,",DIC("W")="W "" "" W "" "",$P($$MOD^ICPTMOD(+Y,""I"",$G(PRDT)),U,3)",D="B"
S DIC(0)="QEZ",DIC("S")="I +$$MODP^ICPTMOD(PROC,Y,""I"",$G(PRDT))>0"
D DQ^DICQ
Q
MOD(ECIEN,MFT,OUTARR) ;Returns modifiers associated with an EC Patient IEN
; Input: ECIEN - IEN entry in file 721/^ECH(
; MFT - format to provide modifier
; "I" - ien format
; "E" - .01 format (default)
;
; Output: OUTARR - output array subscripted by modifer ien or .01 value
; ien^modifier^modifier description
; returns 1 if successful or 0 if unsuccessful
;
I $G(ECIEN)="" Q 0 ;IEN not define.
I '$D(^ECH(ECIEN)) Q 0 ;IEN does not exist in file 721/^ECH(
I $O(^ECH(ECIEN,"MOD",0))="" Q 0 ;No modifiers on file for entry
N MOD,IEN,ECMERR,MODARY,MODESC,SUB,SEQ,ECDT
S MFT=$S($G(MFT)="":"E",1:MFT) I "E^I"'[$E(MFT) S MFT="E"
S ECDT=$P($G(^ECH(ECIEN,0)),U,3)
D GETS^DIQ(721,ECIEN,"36*","IE","MODARY","ECMERR")
I $D(ECMERR) Q 0 ;Error looking up entry
S SEQ="" F S SEQ=$O(MODARY(721.036,SEQ)) Q:SEQ="" D
. S SUB=$G(MODARY(721.036,SEQ,.01,MFT)) I SUB="" Q
. S IEN=$G(MODARY(721.036,SEQ,.01,"I")) I IEN="" Q
. S MOD=$G(MODARY(721.036,SEQ,.01,"E")) I MOD="" S MOD="Unknown"
. S MODESC=$P($$MOD^ICPTMOD(MOD,"E",ECDT),U,3)
. I MODESC="" S MODESC="Unknown"
. S OUTARR(SUB)=IEN_U_MOD_U_MODESC
Q $S($D(OUTARR):1,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECUTL 6004 printed Apr 09, 2024@21:04:22 Page 2
ECUTL ;ALB/GTS/JAM - Event Capture Utilities ;23 Jul 2008
+1 ;;2.0; EVENT CAPTURE ;**10,18,47,63,95**;8 May 96;Build 26
+2 ;
FNDVST(ECVST,ECRECNUM,EC2PCE) ; Search EC Patient records for associated Visits
+1 ;
+2 ; Input: ECVST - Visit file IEN to search for
+3 ; ECRECNUM - Event Capture record number to skip processing
+4 ; EC2PCE - Array passed by reference to contain results
+5 ;
+6 ; Output: ECERR 1 - One of the records to resend lacks a zero node
+7 ; 0 - All of the records to resend have zero nodes
+8 ; EC2PCE - array subscripted by date and pointer
+9 ; to EVENT CAPTURE PATIENT (#721) file
+10 ; [Ex: ECPCE(3080101,611)]
+11 ;
+12 NEW ECIEN,ECERR,ECVAR
+13 IF '$DATA(ECRECNUM)
SET ECRECNUM=0
+14 SET (ECVAR,ECERR)=0
+15 if +ECVST'>0
SET ECERR=1
+16 IF ECERR=0
Begin DoDot:1
+17 SET ECIEN=""
+18 FOR
SET ECIEN=$ORDER(^ECH("C",ECVST,ECIEN))
if +ECIEN=0
QUIT
Begin DoDot:2
+19 if ECRECNUM'=ECIEN
SET ECVAR=$$RSEND(ECIEN,.EC2PCE)
+20 if ECVAR>0
SET ECERR=1
End DoDot:2
End DoDot:1
FNDVSTQ QUIT ECERR
+1 ;
RSEND(ECIEN,ECPCE) ; Prepare EC Patient record for resending to PCE
+1 ;
+2 ; Input: ECIEN - IEN for record to resend to PCE
+3 ; ECPCE - array passed by reference to contain results
+4 ; Output: 0 if successful - EC Patient record will be resent to PCE
+5 ; 1 if Unsuccessful - EC Patient record lacks zero node
+6 ; ECPCE - array subscripted by date and pointer
+7 ; to EVENT CAPTURE PATIENT (#721) file
+8 ; [Ex: ECPCE(3080101,611)]
+9 ;
+10 NEW ECERR,DA,DIE,DR,ECPROCDT
+11 SET ECERR=0
+12 IF '$DATA(^ECH(ECIEN,0))
SET ECERR=1
+13 IF ECERR=0
Begin DoDot:1
+14 SET ECPROCDT=$PIECE(^ECH(ECIEN,0),"^",3)
+15 ;remove set of field #31 and create ECPCE array to pass to
+16 ;direct EC to PCE xfer task
+17 ;S DA=ECIEN,DIE=721,DR="25///@;28///@;31///^S X=ECPROCDT;32///@"
+18 SET DA=ECIEN
SET DIE=721
SET DR="25///@;28///@;32///@"
+19 DO ^DIE
+20 SET ECPCE(ECPROCDT,ECIEN)=""
End DoDot:1
RSENDQ QUIT ECERR
MODSCN() ;Screen CPT Procedure Modifier
+1 NEW ECPT,ECCPT,ECPDT
+2 SET ECCPT=""
IF $GET(ECP)'=""
Begin DoDot:1
+3 SET ECCPT=$SELECT(ECP["EC":$PIECE($GET(^EC(725,+ECP,0)),"^",5),1:+ECP)
End DoDot:1
+4 SET ECPDT=$SELECT($DATA(^ECH(DA,0)):$PIECE(^ECH(DA,0),U,3),$DATA(ECDT):ECDT,1:"")
+5 SET ECPT=$SELECT($DATA(^ECH(DA,"P")):$PIECE(^ECH(DA,"P"),U),ECCPT'="":ECCPT,1:"")
+6 IF ECPT'=""
IF +$$MODP^ICPTMOD(ECPT,+Y,"I",ECPDT)>0
+7 QUIT
ASKMOD(PROC,MOD,PRDT,ECMOD,ECERR) ; Ask CPT modifiers for CPT procedure
+1 ; Input PROC = CPT Procedure
+2 ; MOD = Default modifier
+3 ; PRDT = Date/Time of procedure. Checks modifier status
+4 ;
+5 ;Output ECMOD( array with modifiers
+6 ; ECERR = Error flag 1 - error or 0 - no error.
+7 ;
+8 NEW DTOUT,DUOUT,DIROUT,SUB,I,DEF,DIR,DIC,DSC,IEN,DATA,MODAR
+9 SET ECERR=$GET(ECERR,0)
SET DEF=""
+10 IF PROC=""
SET ECERR=1
GOTO ASKMODQ
+11 IF '$DATA(PRDT)
SET PRDT=""
+12 SET DIC="^ICPT("
SET DIC(0)="N"
SET X=PROC
+13 SET DIC("S")="I $P($$CPT^ICPTCOD(+Y,PRDT),""^"",7)"
+14 DO ^DIC
IF +Y=-1
SET ECERR=1
GOTO ASKMODQ
+15 ;If no modifiers present for CPT code quit
+16 SET DATA=$$CODM^ICPTCOD(PROC,"MODAR","",PRDT)
+17 if $ORDER(MODAR(""))=""
GOTO ASKMODQ
KILL MODAR
+18 ;Set modifiers in ECMOD array if a valid pair (CPT code/modifier)
+19 SET SUB=""
FOR I=1:1
SET SUB=$PIECE(MOD,",",I)
if SUB=""
QUIT
Begin DoDot:1
+20 SET DATA=$$MODP^ICPTMOD(PROC,SUB,"E",PRDT)
+21 IF +DATA'>0
WRITE !?2,"Modifier: ",SUB," Invalid - ",$PIECE(DATA,U,2)
QUIT
+22 SET DSC=$PIECE(DATA,U,2)
SET IEN=$PIECE(DATA,U)
SET ECMOD(PROC,SUB)=DSC_U_IEN
SET DEF=SUB
End DoDot:1
+23 ;List modifiers entered
+24 SET SUB=""
FOR I=1:1
SET SUB=$ORDER(ECMOD(PROC,SUB))
if SUB=""
QUIT
Begin DoDot:1
+25 WRITE !?2,"Modifier: ",SUB," ",$PIECE(ECMOD(PROC,SUB),U)
End DoDot:1
+26 IF DEF'=""
SET DIR("B")=DEF
AGAIN NEW Y,X,DEFX,ECY
+1 SET DIR("A")="Modifier"
SET DIR("?")="^D MODHLP^ECUTL"
+2 SET DIR(0)="FO^^I $$VALMOD^ECUTL(PROC,X,PRDT)"
SET DEFX=""
+3 DO ^DIR
KILL DIR
if X=""
GOTO ASKMODQ
+4 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
KILL ECMOD(PROC)
SET ECERR=1
GOTO ASKMODQ
+5 Begin DoDot:1
+6 IF X="@"
if DEF'=""
KILL ECMOD(PROC,DEF)
WRITE " ...deleted"
QUIT
+7 IF '$DATA(ECY)
QUIT
+8 IF DEF'=DEFX
IF DEFX'=""
IF $DATA(ECMOD(PROC,DEFX))
SET (DEF,DIR("B"))=DEFX
QUIT
+9 KILL DIR("B")
SET ECMOD(PROC,$PIECE(ECY,U,2))=$PIECE(ECY(0),U,2)_U_$PIECE(ECY,U)
SET DEF=""
End DoDot:1
GOTO AGAIN
+10 ;
ASKMODQ QUIT $SELECT(ECERR:0,1:1)
+1 ;
VALMOD(PROC,X,PRDT) ;Validate modifiers
+1 NEW DIC,DTOUT,DUOUT,DIROUT,DUOUT
+2 SET DIC="^DIC(81.3,"
SET DIC(0)="MEQZ"
+3 SET DIC("W")="W "" "" W "" "",$P($$MOD^ICPTMOD(+Y,""I"",$G(PRDT)),U,3)"
+4 SET DIC("S")="I +$$MODP^ICPTMOD(PROC,Y,""I"",PRDT)>0"
+5 DO ^DIC
IF Y<0
KILL X
QUIT 1
+6 MERGE ECY=Y
SET DEFX=$PIECE(Y,U,2)
+7 QUIT 1
MODHLP ;Help for CPT modifiers
+1 NEW DIC,MOD,D
+2 if '$DATA(PROC)
QUIT
IF $DATA(ECMOD(PROC))
Begin DoDot:1
+3 WRITE !?2,"Answer with CPT MODIFIER",!?1,"Choose from:"
+4 SET MOD=""
FOR
SET MOD=$ORDER(ECMOD(PROC,MOD))
if MOD=""
QUIT
WRITE !,?4,MOD
End DoDot:1
+5 WRITE !?6,"You may enter a new CPT MODIFIER, if you wish"
+6 WRITE !?6,"Enter a modifier that is valid for the CPT procedure code."
+7 SET DIC="^DIC(81.3,"
SET DIC("W")="W "" "" W "" "",$P($$MOD^ICPTMOD(+Y,""I"",$G(PRDT)),U,3)"
SET D="B"
+8 SET DIC(0)="QEZ"
SET DIC("S")="I +$$MODP^ICPTMOD(PROC,Y,""I"",$G(PRDT))>0"
+9 DO DQ^DICQ
+10 QUIT
MOD(ECIEN,MFT,OUTARR) ;Returns modifiers associated with an EC Patient IEN
+1 ; Input: ECIEN - IEN entry in file 721/^ECH(
+2 ; MFT - format to provide modifier
+3 ; "I" - ien format
+4 ; "E" - .01 format (default)
+5 ;
+6 ; Output: OUTARR - output array subscripted by modifer ien or .01 value
+7 ; ien^modifier^modifier description
+8 ; returns 1 if successful or 0 if unsuccessful
+9 ;
+10 ;IEN not define.
IF $GET(ECIEN)=""
QUIT 0
+11 ;IEN does not exist in file 721/^ECH(
IF '$DATA(^ECH(ECIEN))
QUIT 0
+12 ;No modifiers on file for entry
IF $ORDER(^ECH(ECIEN,"MOD",0))=""
QUIT 0
+13 NEW MOD,IEN,ECMERR,MODARY,MODESC,SUB,SEQ,ECDT
+14 SET MFT=$SELECT($GET(MFT)="":"E",1:MFT)
IF "E^I"'[$EXTRACT(MFT)
SET MFT="E"
+15 SET ECDT=$PIECE($GET(^ECH(ECIEN,0)),U,3)
+16 DO GETS^DIQ(721,ECIEN,"36*","IE","MODARY","ECMERR")
+17 ;Error looking up entry
IF $DATA(ECMERR)
QUIT 0
+18 SET SEQ=""
FOR
SET SEQ=$ORDER(MODARY(721.036,SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+19 SET SUB=$GET(MODARY(721.036,SEQ,.01,MFT))
IF SUB=""
QUIT
+20 SET IEN=$GET(MODARY(721.036,SEQ,.01,"I"))
IF IEN=""
QUIT
+21 SET MOD=$GET(MODARY(721.036,SEQ,.01,"E"))
IF MOD=""
SET MOD="Unknown"
+22 SET MODESC=$PIECE($$MOD^ICPTMOD(MOD,"E",ECDT),U,3)
+23 IF MODESC=""
SET MODESC="Unknown"
+24 SET OUTARR(SUB)=IEN_U_MOD_U_MODESC
End DoDot:1
+25 QUIT $SELECT($DATA(OUTARR):1,1:0)
