close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/EC2P85PT.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/EC2P85PT.m@ 1046

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

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