source: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/EC2P16PT.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.2 KB
Line 
1EC2P16PT ;ALB/GTS/JAP - PATCH EC*2.0*16 Post-Init Rtn ; 10/28/98
2 ;;2.0; EVENT CAPTURE ;**16**;8 May 96
3 ;
4POST ; entry point
5 N ECVRRV
6 ;* if 725 converted, write message
7 ; since check inserted in addproc subroutine, patch may be re-installed
8 I $$GET1^DID(725,"","","PACKAGE REVISION DATA")["EC*2*16" D
9 .D MES^XPDUTL(" ")
10 .D MES^XPDUTL("It appears that the EC NATIONAL PROCEDURE")
11 .D MES^XPDUTL("file (#725) has already been updated")
12 .D MES^XPDUTL("with Patch EC*2*16.")
13 .D MES^XPDUTL(" ")
14 .D MES^XPDUTL("But the patch may be re-installed...")
15 .D MES^XPDUTL(" ")
16 D ENTUP
17 D F7203
18 Q
19 ;
20ENTUP ;
21 D MES^XPDUTL(" ")
22 D BMES^XPDUTL("Updating the National Procedures file (#725)...")
23 D MES^XPDUTL(" ")
24 ;* inactivate national procedures
25 D INACT^EC725CH7
26 ;* change name of national procedures
27 D NAMECHG^EC725CH8
28 ;* change CPT codes for national procedures
29 D CPTCHG^EC725CH7
30 ;* add new national procedures
31 D ADDPROC^EC725CH8
32 ;* set vrrv node (file #725)
33 S ECVRRV=$$GET1^DID(725,"","","PACKAGE REVISION DATA")
34 S ECVRRV=ECVRRV_"^EC*2*16"
35 D PRD^DILFD(725,ECVRRV)
36 D MES^XPDUTL(" ")
37 D BMES^XPDUTL("Update of EC NATIONAL PROCEDURE file (#725)")
38 D BMES^XPDUTL(" completed...")
39 D MES^XPDUTL(" ")
40 Q
41 ;
42MSGTXT ; Message intro
43 ;; Please forward this message to your local DSS Site Manager or
44 ;; Event Capture ADPAC.
45 ;;
46 ;; A review of the EC EVENT CODE SCREENS file (#720.3) was done
47 ;; after installation of patch EC*2*16 which updated the EC NATIONAL
48 ;; PROCEDURE file (#725). This message provides the results of that
49 ;; review.
50 ;;
51 ;; The EC EVENT CODE SCREENS file (#720.3) records indicated below
52 ;; point to an inactive record in the EC NATIONAL PROCEDURE file
53 ;; (#725) or to an inactive record in the CPT file (#81).
54 ;;
55 ;; The user should use the Inactivate Event Code Screens [ECNACT]
56 ;; option to inactivate the Event Code Screen. If necessary, a new
57 ;; Event Code Screen can be created using a currently active CPT code
58 ;; or National Procedure.
59 ;;
60 ;;QUIT
61 ;
62F7203 ;* inspect/report 720.3
63 D BMES^XPDUTL("Inspecting EC Event Code Screens file (#720.3)...")
64 D BMES^XPDUTL("You will receive a MailMan message regarding file #720.3.")
65 D BMES^XPDUTL(" ")
66 S ZTRTN="F7203Q^EC2P16PT",ZTDESC="File #720.3 Review from EC*2*16",ZTIO=""
67 S ZTDTH=$H,ZTREQ="@",ZTSAVE("ZTREQ")="" D ^%ZTLOAD
68 Q
69 ;
70F7203Q ;* background job entry point
71 N ECPTR,ECPROCT,EC01,ECSCDA,ECFILE,ECDATA,ECLOC,ECCAT,ECCATNM,ECUNIT,ECWORD,ECNAM,ECPROC,ECINACT,COUNT,TXTVAR
72 S COUNT=0 K ^TMP($J,"EC2P16")
73 F I=1:1 S TXTVAR=$P($T(MSGTXT+I),";;",2) Q:TXTVAR="QUIT" D LINE(TXTVAR)
74 S (EC01,ECPROCT)=0
75 F S EC01=$O(^ECJ("B",EC01)) Q:+EC01=0 D
76 .S ECPTR=$P(EC01,"-",4)
77 .S ECSCDA=$O(^ECJ("B",EC01,0))
78 .Q:'$D(^ECJ(ECSCDA,0))
79 .;ignore any ec screen inactivated before this fiscal year
80 .I +$P(^ECJ(ECSCDA,0),"^",2) Q:+$P(^ECJ(ECSCDA,0),"^",2)<2981000
81 .S ECWORD="" I ($P(^ECJ(ECSCDA,0),"^",2)'="")&(+$P(^ECJ(ECSCDA,0),"^",2)<DT) S ECWORD="*inactive* "
82 .S ECFILE=$P(ECPTR,";",2)
83 .;ec screens pointing to file #725
84 .I ECFILE["EC(725" S ECDATA=$G(^EC(725,$P(ECPTR,";",1),0)) D
85 ..S ECINACT=$P(ECDATA,U,3)
86 ..Q:ECINACT=""
87 ..;ignore if procedure inactivated before this fiscal year
88 ..Q:(ECINACT<2981000)
89 ..S Y=ECINACT D DD^%DT S ECINACT=Y
90 ..S ECLOC=$P(EC01,"-",1)
91 ..S ECUNIT=$P(EC01,"-",2)
92 ..S ECCAT=$P(EC01,"-",3)
93 ..S ECLOC=$P($G(^DIC(4,ECLOC,0)),U,1)
94 ..S ECUNIT=$P($G(^ECD(ECUNIT,0)),U,1)
95 ..S:+ECCAT'=0 ECCATNM=$P($G(^EC(726,ECCAT,0)),U,1)
96 ..S:+ECCAT=0 ECCATNM="None"
97 ..S ECPROC=$P(ECDATA,U,1)_" ("_$P(ECDATA,U,2)_")",ECNAM=$P(^ECJ(ECSCDA,0),";",1)
98 ..D LINE(" ")
99 ..D LINE(" The National Procedure for the following "_ECWORD_"Event Code")
100 ..D LINE(" Screen ("_ECNAM_") is inactive or will soon be inactive --")
101 ..D LINE(" Location: "_ECLOC)
102 ..D LINE(" Category: "_ECCATNM)
103 ..D LINE(" DSS Unit: "_ECUNIT)
104 ..D LINE(" Procedure: "_ECPROC)
105 ..D LINE(" Inactivation Date: "_ECINACT)
106 ..S ECPROCT=ECPROCT+1
107 .;ec screens pointing to file #81
108 .I ECFILE["ICPT" S ECDATA=$G(^ICPT($P(ECPTR,";",1),0)) D
109 ..S ECINACT=$P(ECDATA,U,4)
110 ..Q:ECINACT=""
111 ..S ECLOC=$P(EC01,"-",1)
112 ..S ECUNIT=$P(EC01,"-",2)
113 ..S ECCAT=$P(EC01,"-",3)
114 ..S ECLOC=$P($G(^DIC(4,ECLOC,0)),U,1)
115 ..S ECUNIT=$P($G(^ECD(ECUNIT,0)),U,1)
116 ..S:+ECCAT'=0 ECCATNM=$P($G(^EC(726,ECCAT,0)),U,1)
117 ..S:+ECCAT=0 ECCATNM="None"
118 ..S ECPROC=$P(ECDATA,U,2)_" ("_$P(ECDATA,U,1)_")",ECNAM=$P(^ECJ(ECSCDA,0),";",1)
119 ..D LINE(" ")
120 ..D LINE(" The CPT procedure for the following"_ECWORD_" Event")
121 ..D LINE(" Code Screen ("_ECNAM_") is inactive --")
122 ..D LINE(" Location: "_ECLOC)
123 ..D LINE(" Category: "_ECCATNM)
124 ..D LINE(" DSS Unit: "_ECUNIT)
125 ..D LINE(" Procedure: "_ECPROC)
126 ..S ECPROCT=ECPROCT+1
127 I ECPROCT=0 D
128 .D LINE(" ")
129 .D LINE("No Event Code Screens were found to be associated with inactive")
130 .D LINE("National Procedures or inactive CPT codes.")
131 I ECPROCT>0 D
132 .D LINE(" ")
133 .D LINE(" "_ECPROCT_" Event Code Screens were found to be pointing to an inactive")
134 .D LINE(" or soon to be inactive procedure in file #725 or file #81.")
135 .D LINE(" ")
136 D MAIL
137 K ^TMP($J,"EC2P16")
138 Q
139 ;
140LINE(TEXT) ; Add line to message global
141 S COUNT=COUNT+1,^TMP($J,"EC2P16",COUNT)=TEXT
142 Q
143 ;
144MAIL ; Send message
145 N XMDUZ,XMY,XMTEXT,XMSUB
146 S XMY(DUZ)="",XMDUZ=.5
147 S XMSUB="Event Code Screens to Review"
148 S XMTEXT="^TMP($J,""EC2P16"","
149 D ^XMD
150 Q
Note: See TracBrowser for help on using the repository browser.