source: FOIAVistA/tag/r/EVENT_CAPTURE-EC--ECT--ECX/ECUTL.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.1 KB
Line 
1ECUTL ;ALB/GTS/JAM - Event Capture Utilities ;18 May 98
2 ;;2.0; EVENT CAPTURE ;**10,18,47,63**;8 May 96
3 ;
4FNDVST(ECVST,ECRECNUM) ; Search EC Patient records for associated Visits
5 ;
6 ; Input: ECVST - Visit file IEN to search for
7 ; ECRECNUM - Event Capture record number to skip processing
8 ;
9 ; Output: ECERR 1 - One of the records to resend lacks a zero node
10 ; 0 - All of the records to resend have zero nodes
11 ;
12 N ECIEN,ECERR,ECVAR
13 I '$D(ECRECNUM) S ECRECNUM=0
14 S (ECVAR,ECERR)=0
15 S:+ECVST'>0 ECERR=1
16 I ECERR=0 DO
17 .S ECIEN=""
18 .F S ECIEN=$O(^ECH("C",ECVST,ECIEN)) Q:+ECIEN=0 DO
19 ..S:ECRECNUM'=ECIEN ECVAR=$$RSEND(ECIEN)
20 ..S:ECVAR>0 ECERR=1
21FNDVSTQ Q ECERR
22 ;
23RSEND(ECIEN) ; Prepare EC Patient record for resending to PCE
24 ;
25 ; Input: ECIEN - IEN for record to resend to PCE
26 ;
27 ; Output: 0 if successful - EC Patient record will be resent to PCE
28 ; 1 if Unsuccessful - EC Patient record lacks zero node
29 ;
30 N ECERR,DA,DIE,DR,ECPROCDT
31 S ECERR=0
32 I '$D(^ECH(ECIEN,0)) S ECERR=1
33 I ECERR=0 DO
34 .S ECPROCDT=$P(^ECH(ECIEN,0),"^",3)
35 .S DA=ECIEN,DIE=721,DR="25///@;28///@;31///^S X=ECPROCDT;32///@"
36 .D ^DIE
37RSENDQ Q ECERR
38MODSCN() ;Screen CPT Procedure Modifier
39 N ECPT,ECCPT,ECPDT
40 S ECCPT="" I $G(ECP)'="" D
41 . S ECCPT=$S(ECP["EC":$P($G(^EC(725,+ECP,0)),"^",5),1:+ECP)
42 S ECPDT=$S($D(^ECH(DA,0)):$P(^ECH(DA,0),U,3),$D(ECDT):ECDT,1:"")
43 S ECPT=$S($D(^ECH(DA,"P")):$P(^ECH(DA,"P"),U),ECCPT'="":ECCPT,1:"")
44 I ECPT'="",+$$MODP^ICPTMOD(ECPT,+Y,"I",ECPDT)>0
45 Q
46ASKMOD(PROC,MOD,PRDT,ECMOD,ECERR) ; Ask CPT modifiers for CPT procedure
47 ; Input PROC = CPT Procedure
48 ; MOD = Default modifier
49 ; PRDT = Date/Time of procedure. Checks modifier status
50 ;
51 ;Output ECMOD( array with modifiers
52 ; ECERR = Error flag 1 - error or 0 - no error.
53 ;
54 N DTOUT,DUOUT,DIROUT,SUB,I,DEF,DIR,DIC,DSC,IEN,DATA,MODAR
55 S ECERR=$G(ECERR,0),DEF=""
56 I PROC="" S ECERR=1 G ASKMODQ
57 I '$D(PRDT) S PRDT=""
58 S DIC="^ICPT(",DIC(0)="N",X=PROC
59 S DIC("S")="I $P($$CPT^ICPTCOD(+Y,PRDT),""^"",7)"
60 D ^DIC I +Y=-1 S ECERR=1 G ASKMODQ
61 ;If no modifiers present for CPT code quit
62 S DATA=$$CODM^ICPTCOD(PROC,"MODAR","",PRDT)
63 G:$O(MODAR(""))="" ASKMODQ K MODAR
64 ;Set modifiers in ECMOD array if a valid pair (CPT code/modifier)
65 S SUB="" F I=1:1 S SUB=$P(MOD,",",I) Q:SUB="" D
66 . S DATA=$$MODP^ICPTMOD(PROC,SUB,"E",PRDT)
67 . I +DATA'>0 W !?2,"Modifier: ",SUB," Invalid - ",$P(DATA,U,2) Q
68 . S DSC=$P(DATA,U,2),IEN=$P(DATA,U),ECMOD(PROC,SUB)=DSC_U_IEN,DEF=SUB
69 ;List modifiers entered
70 S SUB="" F I=1:1 S SUB=$O(ECMOD(PROC,SUB)) Q:SUB="" D
71 . W !?2,"Modifier: ",SUB," ",$P(ECMOD(PROC,SUB),U)
72 I DEF'="" S DIR("B")=DEF
73AGAIN N Y,X,DEFX,ECY
74 S DIR("A")="Modifier",DIR("?")="^D MODHLP^ECUTL"
75 S DIR(0)="FO^^I $$VALMOD^ECUTL(PROC,X,PRDT)",DEFX=""
76 D ^DIR K DIR G:X="" ASKMODQ
77 I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) K ECMOD(PROC) S ECERR=1 G ASKMODQ
78 D G AGAIN
79 . I X="@" K:DEF'="" ECMOD(PROC,DEF) W " ...deleted" Q
80 . I '$D(ECY) Q
81 . I DEF'=DEFX,DEFX'="",$D(ECMOD(PROC,DEFX)) S (DEF,DIR("B"))=DEFX Q
82 . K DIR("B") S ECMOD(PROC,$P(ECY,U,2))=$P(ECY(0),U,2)_U_$P(ECY,U),DEF=""
83 ;
84ASKMODQ Q $S(ECERR:0,1:1)
85 ;
86VALMOD(PROC,X,PRDT) ;Validate modifiers
87 N DIC,DTOUT,DUOUT,DIROUT,DUOUT
88 S DIC="^DIC(81.3,",DIC(0)="MEQZ"
89 S DIC("W")="W "" "" W "" "",$P($$MOD^ICPTMOD(+Y,""I"",$G(PRDT)),U,3)"
90 S DIC("S")="I +$$MODP^ICPTMOD(PROC,Y,""I"",PRDT)>0"
91 D ^DIC I Y<0 K X Q 1
92 M ECY=Y S DEFX=$P(Y,U,2)
93 Q 1
94MODHLP ;Help for CPT modifiers
95 N DIC,MOD,D
96 Q:'$D(PROC) I $D(ECMOD(PROC)) D
97 . W !?2,"Answer with CPT MODIFIER",!?1,"Choose from:"
98 . S MOD="" F S MOD=$O(ECMOD(PROC,MOD)) Q:MOD="" W !,?4,MOD
99 W !?6,"You may enter a new CPT MODIFIER, if you wish"
100 W !?6,"Enter a modifier that is valid for the CPT procedure code."
101 S DIC="^DIC(81.3,",DIC("W")="W "" "" W "" "",$P($$MOD^ICPTMOD(+Y,""I"",$G(PRDT)),U,3)",D="B"
102 S DIC(0)="QEZ",DIC("S")="I +$$MODP^ICPTMOD(PROC,Y,""I"",$G(PRDT))>0"
103 D DQ^DICQ
104 Q
105MOD(ECIEN,MFT,OUTARR) ;Returns modifiers associated with an EC Patient IEN
106 ; Input: ECIEN - IEN entry in file 721/^ECH(
107 ; MFT - format to provide modifier
108 ; "I" - ien format
109 ; "E" - .01 format (default)
110 ;
111 ; Output: OUTARR - output array subscripted by modifer ien or .01 value
112 ; ien^modifier^modifier description
113 ; returns 1 if successful or 0 if unsuccessful
114 ;
115 I $G(ECIEN)="" Q 0 ;IEN not define.
116 I '$D(^ECH(ECIEN)) Q 0 ;IEN does not exist in file 721/^ECH(
117 I $O(^ECH(ECIEN,"MOD",0))="" Q 0 ;No modifiers on file for entry
118 N MOD,IEN,ECMERR,MODARY,MODESC,SUB,SEQ,ECDT
119 S MFT=$S($G(MFT)="":"E",1:MFT) I "E^I"'[$E(MFT) S MFT="E"
120 S ECDT=$P($G(^ECH(ECIEN,0)),U,3)
121 D GETS^DIQ(721,ECIEN,"36*","IE","MODARY","ECMERR")
122 I $D(ECMERR) Q 0 ;Error looking up entry
123 S SEQ="" F S SEQ=$O(MODARY(721.036,SEQ)) Q:SEQ="" D
124 . S SUB=$G(MODARY(721.036,SEQ,.01,MFT)) I SUB="" Q
125 . S IEN=$G(MODARY(721.036,SEQ,.01,"I")) I IEN="" Q
126 . S MOD=$G(MODARY(721.036,SEQ,.01,"E")) I MOD="" S MOD="Unknown"
127 . S MODESC=$P($$MOD^ICPTMOD(MOD,"E",ECDT),U,3)
128 . I MODESC="" S MODESC="Unknown"
129 . S OUTARR(SUB)=IEN_U_MOD_U_MODESC
130 Q $S($D(OUTARR):1,1:0)
Note: See TracBrowser for help on using the repository browser.