Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECP115PT

ECP115PT.m

Go to the documentation of this file.
  1. ECP115PT ;ALB/BR - PATCH EC*2.0*115 Post-Init Rtn ; 1/19/10 2:48pm
  1. ;;2.0;EVENT CAPTURE;**115**;8 May 96;Build 12
  1. ;
  1. Q
  1. POST ; entry point
  1. N ECVRRV
  1. ;* if 725 converted, write message
  1. ; since check inserted in addproc subroutine, patch may be re-installed
  1. I $$GET1^DID(725,"","","PACKAGE REVISION DATA")["EC*2*115" D
  1. .D MES^XPDUTL(" ")
  1. .D MES^XPDUTL("It appears that the EC NATIONAL PROCEDURE")
  1. .D MES^XPDUTL("file (#725) has already been updated")
  1. .D MES^XPDUTL("with Patch EC*2*115.")
  1. .D MES^XPDUTL(" ")
  1. .D MES^XPDUTL("But the patch may be re-installed...")
  1. .D MES^XPDUTL(" ")
  1. D ENTUP
  1. D F7203
  1. D KILL1
  1. Q
  1. ;
  1. ENTUP ;
  1. D MES^XPDUTL(" ")
  1. D BMES^XPDUTL("Updating the National Procedures file (#725)...")
  1. D MES^XPDUTL(" ")
  1. ;* add new/edit national procedures
  1. D ADDPROC^EC725U62 ;add new procedures
  1. D NAMECHG^EC725U62 ;change description
  1. D CPTCHG^EC725U63 ;change CPT code
  1. D INACT^EC725U63 ;inactivate code
  1. ;D REACT^EC725U63 ;reactivate code
  1. ;* set VRRV node (file #725)
  1. S ECVRRV=$$GET1^DID(725,"","","PACKAGE REVISION DATA")
  1. S ECVRRV=ECVRRV_"^EC*2*115"
  1. D PRD^DILFD(725,ECVRRV)
  1. D MES^XPDUTL(" ")
  1. D BMES^XPDUTL("Update of EC NATIONAL PROCEDURE file (#725)")
  1. D BMES^XPDUTL(" completed...")
  1. D MES^XPDUTL(" ")
  1. Q
  1. MSGTXT ; Message intro
  1. ;; Please forward this message to your local DSS Site Manager or
  1. ;; Event Capture ADPAC.;; Event Capture ADPAC.
  1. ;;
  1. ;; A review of the EC EVENT CODE SCREENS file (#720.3) was done
  1. ;; after installation of patch EC*2*115 which updated the EC NATIONAL
  1. ;; PROCEDURE file (#725). This message provides the results of that
  1. ;; review.
  1. ;;
  1. ;; The EC EVENT CODE SCREENS file (#720.3) records indicated below
  1. ;; point to an inactive record in the EC NATIONAL PROCEDURE file
  1. ;; (#725) or to an inactive record in the CPT file (#81).
  1. ;;
  1. ;; The user should use the Inactivate Event Code Screens [ECNACT]
  1. ;; option to inactivate the Event Code Screen. If necessary, a new
  1. ;; Event Code Screen can be created using a currently active CPT code
  1. ;; or National Procedure.
  1. ;;
  1. ;;QUIT
  1. ;
  1. F7203 ;* inspect/report 720.3
  1. D BMES^XPDUTL("Inspecting EC Event Code Screens file (#720.3)...")
  1. D BMES^XPDUTL("You will receive a MailMan message regarding file #720.3 ")
  1. D BMES^XPDUTL(" ")
  1. S ZTRTN="F7203Q^ECP115PT",ZTDESC="File #720.3 Review from EC*2*115",ZTIO=""
  1. S ZTDTH=$H,ZTREQ="@",ZTSAVE("ZTREQ")="" D ^%ZTLOAD
  1. Q
  1. ;
  1. F7203Q ;* background job entry point
  1. N ECPTR,ECPROCT,EC01,ECSCDA,ECFILE,ECDATA,ECLOC,ECCAT,ECCATNM,ECUNIT,ECNAM,ECPROC,ECINACT,COUNT,TXTVAR
  1. S COUNT=0 K ^TMP($J,"ECP115")
  1. F I=1:1 S TXTVAR=$P($T(MSGTXT+I),";;",2) Q:TXTVAR="QUIT" D LINE(TXTVAR)
  1. S (EC01,ECPROCT)=0
  1. F S EC01=$O(^ECJ("B",EC01)) Q:+EC01=0 D
  1. .S ECPTR=$P(EC01,"-",4),ECSCDA=$O(^ECJ("B",EC01,0))
  1. .Q:'$D(^ECJ(ECSCDA,0))
  1. .;ignore any ec screen that has been inactivated
  1. .Q:+$P(^ECJ(ECSCDA,0),"^",2)
  1. .S ECFILE=$P(ECPTR,";",2)
  1. .;ec screens pointing to file #725
  1. .I ECFILE["EC(725" S ECDATA=$G(^EC(725,$P(ECPTR,";",1),0)) D
  1. ..S ECINACT=$P(ECDATA,U,3)
  1. ..Q:ECINACT=""
  1. ..;ignore if procedure inactivated before this fiscal year
  1. ..Q:(ECINACT<3110104)
  1. ..S Y=ECINACT D DD^%DT S ECINACT=Y
  1. ..S ECLOC=$P(EC01,"-",1),ECUNIT=$P(EC01,"-",2),ECCAT=$P(EC01,"-",3)
  1. ..S ECLOC=$P($G(^DIC(4,ECLOC,0)),U,1),ECUNIT=$P($G(^ECD(ECUNIT,0)),U,1)
  1. ..S:+ECCAT'=0 ECCATNM=$P($G(^EC(726,ECCAT,0)),U,1)
  1. ..S:+ECCAT=0 ECCATNM="None"
  1. ..S ECPROC=$P(ECDATA,U,1)_" ("_$P(ECDATA,U,2)_")"
  1. ..S ECNAM=$P(^ECJ(ECSCDA,0),";",1)
  1. ..D LINE(" ")
  1. ..D LINE(" The National Procedure for the following Event Code")
  1. ..D LINE(" Screen ("_ECNAM_") is inactive or will soon be inactive --")
  1. ..D LINE(" Location: "_ECLOC)
  1. ..D LINE(" Category: "_ECCATNM)
  1. ..D LINE(" DSS Unit: "_ECUNIT)
  1. ..D LINE(" Procedure: "_ECPROC)
  1. ..D LINE(" Inactivation Date: "_ECINACT)
  1. ..S ECPROCT=ECPROCT+1
  1. .;ec screens pointing to file #81
  1. .I ECFILE["ICPT" S ECDATA=$G(^ICPT($P(ECPTR,";",1),0)) D
  1. ..S ECINACT=$P(ECDATA,U,4)
  1. ..Q:ECINACT=""
  1. ..S ECLOC=$P(EC01,"-",1),ECUNIT=$P(EC01,"-",2),ECCAT=$P(EC01,"-",3)
  1. ..S ECLOC=$P($G(^DIC(4,ECLOC,0)),U,1),ECUNIT=$P($G(^ECD(ECUNIT,0)),U,1)
  1. ..S:+ECCAT'=0 ECCATNM=$P($G(^EC(726,ECCAT,0)),U,1)
  1. ..S:+ECCAT=0 ECCATNM="None"
  1. ..S ECPROC=$P(ECDATA,U,2)_" ("_$P(ECDATA,U,1)_")",ECNAM=$P(^ECJ(ECSCDA,0),";",1)
  1. ..D LINE(" ")
  1. ..D LINE(" The CPT procedure for the following Event")
  1. ..D LINE(" Code Screen ("_ECNAM_") is inactive --")
  1. ..D LINE(" Location: "_ECLOC)
  1. ..D LINE(" Category: "_ECCATNM)
  1. ..D LINE(" DSS Unit: "_ECUNIT)
  1. ..D LINE(" Procedure: "_ECPROC)
  1. ..S ECPROCT=ECPROCT+1
  1. I ECPROCT=0 D
  1. .D LINE(" ")
  1. .D LINE(" "_ECPROCT_" Event Code Screens were found to be pointing to an inactive")
  1. .D LINE(" or soon to be inactive procedure in file #725 or file #81.")
  1. .D LINE(" ")
  1. D MAIL
  1. K ^TMP($J,"ECP115"),I,Y
  1. Q
  1. ;
  1. LINE(TEXT) ; Add line to message global
  1. S COUNT=COUNT+1,^TMP($J,"ECP115",COUNT)=TEXT
  1. Q
  1. ;
  1. MAIL ; Send message
  1. N XMDUZ,XMY,XMTEXT,XMSUB
  1. S XMY(DUZ)="",XMDUZ=.5
  1. S XMSUB="Event Code Screens to Review"
  1. S XMTEXT="^TMP($J,""ECP115"","
  1. D ^XMD
  1. Q
  1. KILL1 ;
  1. K ZTDESC,ZTDTH,ZTIO,ZTREQ,ZTRTN,ZTSAVE("ZTREQ")
  1. Q