source: FOIAVistA/tag/r/EVENT_CAPTURE-EC--ECT--ECX/EC2P24PT.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 
1EC2P24PT ;ALB/JAM - PATCH EC*2.0*24 Post-Init Rtn ; 04/19/00
2 ;;2.0; EVENT CAPTURE ;**24**;04 Apr 2000
3 ;
4POST ; entry point
5 ;* search file #725 for invalid CPT IENs then file 721.
6 S ECJ=$J K ^TMP(ECJ,"EC2P24")
7 D F725SRH
8 D BKGPRC
9 D MES^XPDUTL(" ")
10 D BMES^XPDUTL(" completed...")
11 D MES^XPDUTL(" ")
12 Q
13 ;
14F725SRH ; Locate invalid CPT codes in file 725 and correct them
15 N IEN,CPT,ECX,DA,DIE,CPTIEN,DR
16 S IEN=0
17 D MES^XPDUTL(" ")
18 D BMES^XPDUTL("Correcting CPT IEN in EC NATIONAL PROCEDURE file(#725)...")
19 D MES^XPDUTL(" ")
20 F S IEN=$O(^EC(725,IEN)) Q:'IEN D
21 . S ECX=$G(^EC(725,IEN,0)),CPT=$P(ECX,U,5) I CPT="" Q
22 . I $D(^ICPT(CPT)) Q
23 . I $D(^ICPT("B",CPT)) D Q
24 . . S CPTIEN=$O(^ICPT("B",CPT,0))
25 . . I CPTIEN="" S ^TMP(ECJ,"EC2P24","F725",IEN)=CPT_U_ECX Q
26 . . K DIE,DR S DA=IEN,DR="4////"_CPTIEN,DIE="^EC(725," D ^DIE K DR
27 . . D MES^XPDUTL(" ")
28 . . D BMES^XPDUTL(" Entry #"_IEN_" for "_$P(ECX,U)_" ["_$P(ECX,U,2)_"]")
29 . . D BMES^XPDUTL(" ...updated to use CPT IEN "_CPTIEN_".")
30 . S ^TMP(ECJ,"EC2P24","F725",IEN)=CPT_U_ECX Q
31 Q
32 ;
33F721SRH ; Locate invalid CPT code in file 721 and corrects it
34 N ECD,ECSD,ECED,ECPT,EC,ECDA,FLG,ERR,CPTIEN,X,Y
35 S %DT="X",X="12/22/99" D ^%DT S ECSD=Y,ECD=ECSD-.1
36 D NOW^%DTC S ECED=%
37 F S ECD=$O(^ECH("AC",ECD)) Q:'ECD Q:ECD>ECED S ECDA=0 D
38 . F S ECDA=$O(^ECH("AC",ECD,ECDA)) Q:'ECDA D
39 . . S EC=$G(^ECH(ECDA,"P")),ECPT=$P(EC,U),ERR=0 I ECPT="" Q
40 . . I $D(^ICPT(ECPT)) Q
41 . . S EC(0)=$G(^ECH(ECDA,0)) I EC(0)="" Q
42 . . D
43 . . . S CPTIEN=$O(^ICPT("B",ECPT,0)) I CPTIEN="" S ERR=1 Q
44 . . . I '$D(^ICPT(CPTIEN)) S ERR=1 Q
45 . . . S $P(^ECH(ECDA,"P"),U)=CPTIEN
46 . . . S FLG=$$FIX721(ECDA,.EC)
47 . . S ^TMP(ECJ,"EC2P24","F721",ECDA)=ECPT_U_ERR_U_EC(0)
48 K DIE,DA,DR
49 Q
50 ;
51MSGTXT ; Message intro
52 ;; Please forward this message to your local DSS Site Manager or
53 ;; Event Capture ADPAC.
54 ;;
55 ;; A review of the EVENT CAPTURE PATIENT file (#721) was done on
56 ;; CPT codes for the period 12/22/99-present. This message provides
57 ;; the result of encounters found with invalid CPT code during that
58 ;; period. If the encounter had a CPT code that was stored in its
59 ;; external format it was corrected with the corresponding internal
60 ;; entry number and shows on the list below with a status of 'C'.
61 ;; If the entry status is shown as 'NC', the user should use the
62 ;; 'Enter/Edit Patient Procedures' [ECPAT] option to correct these
63 ;; entries to have the proper CPT code.
64 ;;
65 ;;QUIT
66 ;
67BKGPRC ;* print entrie with invalid CPT codes
68 D BMES^XPDUTL("You will receive a MailMan message regarding invalid CPT entries in file #721 and #725")
69 D BMES^XPDUTL(" ")
70 S ZTRTN="PROCESS^EC2P24PT",ZTDESC="File #721 Review from EC*2*24"
71 S ZTIO="",ZTDTH=$H,ZTREQ="@",ZTSAVE("ZTREQ")="",ZTSAVE("ECJ")="" D ^%ZTLOAD
72 Q
73 ;
74PROCESS ;* background job entry point
75 N IEN,COUNT,TXTVAR,BL,ECDT,ECY,I,STA,ECPT
76 D F721SRH
77 S COUNT=0,$P(BL," ",40)=" "
78 F I=1:1 S TXTVAR=$P($T(MSGTXT+I),";;",2) Q:TXTVAR="QUIT" D LINE(TXTVAR)
79 D LINE(" ")
80 D LINE(" ")
81 D LINE("721 IEN PATIENT IEN DATE/TIME OLD/NEW CPT CODE STA")
82 D LINE("------- ----------- --------- ---------------- ---")
83 S IEN=0
84 F S IEN=$O(^TMP(ECJ,"EC2P24","F721",IEN)) Q:'IEN D
85 . S ECX=^TMP(ECJ,"EC2P24","F721",IEN),STA=$P(ECX,U,2)
86 . S STA=$S(STA:"NC",1:"C")
87 . S ECPT=$P(ECX,U)_"/"_$S(STA:"",1:$P($G(^ECH(IEN,"P")),U))
88 . S Y=$P(ECX,U,5) X ^DD("DD") S ECDT=Y
89 . S ECY=$E(IEN_BL,1,15)_$E($P(ECX,U,4)_BL,1,15)_$E(ECDT_BL,1,24)
90 . S ECY=ECY_$E(ECPT_BL,1,20)_STA
91 . D LINE(ECY)
92 I $D(^TMP(ECJ,"EC2P24","F721")) D
93 . D LINE(" ")
94 . D LINE("C - Corrected")
95 . D LINE("NC - Not Corrected")
96 I $D(^TMP(ECJ,"EC2P24","F725")) D
97 . D LINE(" ")
98 . D LINE(" ")
99 . D LINE(" ")
100 . D LINE("CPT entries found in EC NATIONAL PROCEDURE FILE #725")
101 . D LINE("that could not be located in the CPT file #81")
102 . D LINE(" ")
103 . D LINE("725 IEN EC NATIONAL CODE CPT CODE")
104 . D LINE("------- ---------------- --------")
105 . S IEN=0 F S IEN=$O(^TMP(ECJ,"EC2P24","F725",IEN)) Q:'IEN D
106 . . S ECX=^TMP(ECJ,"EC2P24","F725",IEN)
107 . . S ECY=$E(IEN_BL,1,15)_$E($P(ECX,U,2)_BL,1,36)_" "_$P(ECX,U)
108 . . D LINE(ECY)
109 I '$D(^TMP(ECJ,"EC2P24","F721")) D
110 .D LINE(" ")
111 .D LINE(" No entries found in EVENT CAPTURE PATIENT file #721 that")
112 .D LINE(" needs correction.")
113 .D LINE(" ")
114 K ^TMP(ECJ,"EC2P24","F721"),^TMP(ECJ,"EC2P24","F725")
115 D MAIL
116 K ^TMP(ECJ,"EC2P24"),ECJ
117 Q
118 ;
119LINE(TEXT) ; Add line to message global
120 S COUNT=COUNT+1,^TMP(ECJ,"EC2P24",COUNT)=TEXT
121 Q
122 ;
123MAIL ; Send message
124 N XMDUZ,XMY,XMTEXT,XMSUB
125 S XMY(DUZ)="",XMDUZ=.5
126 S XMSUB="Event Capture Patient CPT Code Review"
127 S XMTEXT="^TMP(ECJ,""EC2P24"","
128 D ^XMD
129 Q
130FIX721(ECFN,EC) ;Fix bad CPT code entry in file #721
131 ; Input: ECFN - Event Capture file #721 IEN
132 ; EC - Zero (0) and "P" nodes in file #721
133 ;
134 ; Output: - Returns 1 if fixed and 0 if failed
135 ;
136 N EC4,ECDX,ECP,ECCPT,ECINP,ECPCE,ECD,NODE,ECDT
137 S EC4=$P(EC(0),"^",19),ECDX=$P(EC,"^",2),ECP=$P(EC(0),"^",9)
138 S ECCPT=$S(ECP["EC":$P($G(^EC(725,+ECP,0)),"^",5),1:+ECP)
139 S ECINP=$P(EC(0),"^",22),ECD=$P(EC(0),"^",7),NODE=$G(^ECD(ECD,0))
140 S ECPCE="U~"_$S($P(NODE,"^",14)]"":$P(NODE,"^",14),1:"N")
141 D NOW^%DTC S ECDT=%
142 D PCEE^ECBEN2U
143 Q 1
Note: See TracBrowser for help on using the repository browser.