EC2P16PT ;ALB/GTS/JAP - PATCH EC*2.0*16 Post-Init Rtn ; 10/28/98
;;2.0; EVENT CAPTURE ;**16**;8 May 96
;
POST ; entry point
N ECVRRV
;* if 725 converted, write message
; since check inserted in addproc subroutine, patch may be re-installed
I $$GET1^DID(725,"","","PACKAGE REVISION DATA")["EC*2*16" D
.D MES^XPDUTL(" ")
.D MES^XPDUTL("It appears that the EC NATIONAL PROCEDURE")
.D MES^XPDUTL("file (#725) has already been updated")
.D MES^XPDUTL("with Patch EC*2*16.")
.D MES^XPDUTL(" ")
.D MES^XPDUTL("But the patch may be re-installed...")
.D MES^XPDUTL(" ")
D ENTUP
D F7203
Q
;
ENTUP ;
D MES^XPDUTL(" ")
D BMES^XPDUTL("Updating the National Procedures file (#725)...")
D MES^XPDUTL(" ")
;* inactivate national procedures
D INACT^EC725CH7
;* change name of national procedures
D NAMECHG^EC725CH8
;* change CPT codes for national procedures
D CPTCHG^EC725CH7
;* add new national procedures
D ADDPROC^EC725CH8
;* set vrrv node (file #725)
S ECVRRV=$$GET1^DID(725,"","","PACKAGE REVISION DATA")
S ECVRRV=ECVRRV_"^EC*2*16"
D PRD^DILFD(725,ECVRRV)
D MES^XPDUTL(" ")
D BMES^XPDUTL("Update of EC NATIONAL PROCEDURE file (#725)")
D BMES^XPDUTL(" completed...")
D MES^XPDUTL(" ")
Q
;
MSGTXT ; Message intro
;; Please forward this message to your local DSS Site Manager or
;; Event Capture ADPAC.
;;
;; A review of the EC EVENT CODE SCREENS file (#720.3) was done
;; after installation of patch EC*2*16 which updated the EC NATIONAL
;; PROCEDURE file (#725). This message provides the results of that
;; review.
;;
;; The EC EVENT CODE SCREENS file (#720.3) records indicated below
;; point to an inactive record in the EC NATIONAL PROCEDURE file
;; (#725) or to an inactive record in the CPT file (#81).
;;
;; The user should use the Inactivate Event Code Screens [ECNACT]
;; option to inactivate the Event Code Screen. If necessary, a new
;; Event Code Screen can be created using a currently active CPT code
;; or National Procedure.
;;
;;QUIT
;
F7203 ;* inspect/report 720.3
D BMES^XPDUTL("Inspecting EC Event Code Screens file (#720.3)...")
D BMES^XPDUTL("You will receive a MailMan message regarding file #720.3.")
D BMES^XPDUTL(" ")
S ZTRTN="F7203Q^EC2P16PT",ZTDESC="File #720.3 Review from EC*2*16",ZTIO=""
S ZTDTH=$H,ZTREQ="@",ZTSAVE("ZTREQ")="" D ^%ZTLOAD
Q
;
F7203Q ;* background job entry point
N ECPTR,ECPROCT,EC01,ECSCDA,ECFILE,ECDATA,ECLOC,ECCAT,ECCATNM,ECUNIT,ECWORD,ECNAM,ECPROC,ECINACT,COUNT,TXTVAR
S COUNT=0 K ^TMP($J,"EC2P16")
F I=1:1 S TXTVAR=$P($T(MSGTXT+I),";;",2) Q:TXTVAR="QUIT" D LINE(TXTVAR)
S (EC01,ECPROCT)=0
F S EC01=$O(^ECJ("B",EC01)) Q:+EC01=0 D
.S ECPTR=$P(EC01,"-",4)
.S ECSCDA=$O(^ECJ("B",EC01,0))
.Q:'$D(^ECJ(ECSCDA,0))
.;ignore any ec screen inactivated before this fiscal year
.I +$P(^ECJ(ECSCDA,0),"^",2) Q:+$P(^ECJ(ECSCDA,0),"^",2)<2981000
.S ECWORD="" I ($P(^ECJ(ECSCDA,0),"^",2)'="")&(+$P(^ECJ(ECSCDA,0),"^",2)<DT) S ECWORD="*inactive* "
.S ECFILE=$P(ECPTR,";",2)
.;ec screens pointing to file #725
.I ECFILE["EC(725" S ECDATA=$G(^EC(725,$P(ECPTR,";",1),0)) D
..S ECINACT=$P(ECDATA,U,3)
..Q:ECINACT=""
..;ignore if procedure inactivated before this fiscal year
..Q:(ECINACT<2981000)
..S Y=ECINACT D DD^%DT S ECINACT=Y
..S ECLOC=$P(EC01,"-",1)
..S ECUNIT=$P(EC01,"-",2)
..S ECCAT=$P(EC01,"-",3)
..S ECLOC=$P($G(^DIC(4,ECLOC,0)),U,1)
..S ECUNIT=$P($G(^ECD(ECUNIT,0)),U,1)
..S:+ECCAT'=0 ECCATNM=$P($G(^EC(726,ECCAT,0)),U,1)
..S:+ECCAT=0 ECCATNM="None"
..S ECPROC=$P(ECDATA,U,1)_" ("_$P(ECDATA,U,2)_")",ECNAM=$P(^ECJ(ECSCDA,0),";",1)
..D LINE(" ")
..D LINE(" The National Procedure for the following "_ECWORD_"Event Code")
..D LINE(" Screen ("_ECNAM_") is inactive or will soon be inactive --")
..D LINE(" Location: "_ECLOC)
..D LINE(" Category: "_ECCATNM)
..D LINE(" DSS Unit: "_ECUNIT)
..D LINE(" Procedure: "_ECPROC)
..D LINE(" Inactivation Date: "_ECINACT)
..S ECPROCT=ECPROCT+1
.;ec screens pointing to file #81
.I ECFILE["ICPT" S ECDATA=$G(^ICPT($P(ECPTR,";",1),0)) D
..S ECINACT=$P(ECDATA,U,4)
..Q:ECINACT=""
..S ECLOC=$P(EC01,"-",1)
..S ECUNIT=$P(EC01,"-",2)
..S ECCAT=$P(EC01,"-",3)
..S ECLOC=$P($G(^DIC(4,ECLOC,0)),U,1)
..S ECUNIT=$P($G(^ECD(ECUNIT,0)),U,1)
..S:+ECCAT'=0 ECCATNM=$P($G(^EC(726,ECCAT,0)),U,1)
..S:+ECCAT=0 ECCATNM="None"
..S ECPROC=$P(ECDATA,U,2)_" ("_$P(ECDATA,U,1)_")",ECNAM=$P(^ECJ(ECSCDA,0),";",1)
..D LINE(" ")
..D LINE(" The CPT procedure for the following"_ECWORD_" Event")
..D LINE(" Code Screen ("_ECNAM_") is inactive --")
..D LINE(" Location: "_ECLOC)
..D LINE(" Category: "_ECCATNM)
..D LINE(" DSS Unit: "_ECUNIT)
..D LINE(" Procedure: "_ECPROC)
..S ECPROCT=ECPROCT+1
I ECPROCT=0 D
.D LINE(" ")
.D LINE("No Event Code Screens were found to be associated with inactive")
.D LINE("National Procedures or inactive CPT codes.")
I ECPROCT>0 D
.D LINE(" ")
.D LINE(" "_ECPROCT_" Event Code Screens were found to be pointing to an inactive")
.D LINE(" or soon to be inactive procedure in file #725 or file #81.")
.D LINE(" ")
D MAIL
K ^TMP($J,"EC2P16")
Q
;
LINE(TEXT) ; Add line to message global
S COUNT=COUNT+1,^TMP($J,"EC2P16",COUNT)=TEXT
Q
;
MAIL ; Send message
N XMDUZ,XMY,XMTEXT,XMSUB
S XMY(DUZ)="",XMDUZ=.5
S XMSUB="Event Code Screens to Review"
S XMTEXT="^TMP($J,""EC2P16"","
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEC2P16PT 5479 printed Dec 13, 2024@01:55:50 Page 2
EC2P16PT ;ALB/GTS/JAP - PATCH EC*2.0*16 Post-Init Rtn ; 10/28/98
+1 ;;2.0; EVENT CAPTURE ;**16**;8 May 96
+2 ;
POST ; entry point
+1 NEW ECVRRV
+2 ;* if 725 converted, write message
+3 ; since check inserted in addproc subroutine, patch may be re-installed
+4 IF $$GET1^DID(725,"","","PACKAGE REVISION DATA")["EC*2*16"
Begin DoDot:1
+5 DO MES^XPDUTL(" ")
+6 DO MES^XPDUTL("It appears that the EC NATIONAL PROCEDURE")
+7 DO MES^XPDUTL("file (#725) has already been updated")
+8 DO MES^XPDUTL("with Patch EC*2*16.")
+9 DO MES^XPDUTL(" ")
+10 DO MES^XPDUTL("But the patch may be re-installed...")
+11 DO MES^XPDUTL(" ")
End DoDot:1
+12 DO ENTUP
+13 DO F7203
+14 QUIT
+15 ;
ENTUP ;
+1 DO MES^XPDUTL(" ")
+2 DO BMES^XPDUTL("Updating the National Procedures file (#725)...")
+3 DO MES^XPDUTL(" ")
+4 ;* inactivate national procedures
+5 DO INACT^EC725CH7
+6 ;* change name of national procedures
+7 DO NAMECHG^EC725CH8
+8 ;* change CPT codes for national procedures
+9 DO CPTCHG^EC725CH7
+10 ;* add new national procedures
+11 DO ADDPROC^EC725CH8
+12 ;* set vrrv node (file #725)
+13 SET ECVRRV=$$GET1^DID(725,"","","PACKAGE REVISION DATA")
+14 SET ECVRRV=ECVRRV_"^EC*2*16"
+15 DO PRD^DILFD(725,ECVRRV)
+16 DO MES^XPDUTL(" ")
+17 DO BMES^XPDUTL("Update of EC NATIONAL PROCEDURE file (#725)")
+18 DO BMES^XPDUTL(" completed...")
+19 DO MES^XPDUTL(" ")
+20 QUIT
+21 ;
MSGTXT ; Message intro
+1 ;; Please forward this message to your local DSS Site Manager or
+2 ;; Event Capture ADPAC.
+3 ;;
+4 ;; A review of the EC EVENT CODE SCREENS file (#720.3) was done
+5 ;; after installation of patch EC*2*16 which updated the EC NATIONAL
+6 ;; PROCEDURE file (#725). This message provides the results of that
+7 ;; review.
+8 ;;
+9 ;; The EC EVENT CODE SCREENS file (#720.3) records indicated below
+10 ;; point to an inactive record in the EC NATIONAL PROCEDURE file
+11 ;; (#725) or to an inactive record in the CPT file (#81).
+12 ;;
+13 ;; The user should use the Inactivate Event Code Screens [ECNACT]
+14 ;; option to inactivate the Event Code Screen. If necessary, a new
+15 ;; Event Code Screen can be created using a currently active CPT code
+16 ;; or National Procedure.
+17 ;;
+18 ;;QUIT
+19 ;
F7203 ;* inspect/report 720.3
+1 DO BMES^XPDUTL("Inspecting EC Event Code Screens file (#720.3)...")
+2 DO BMES^XPDUTL("You will receive a MailMan message regarding file #720.3.")
+3 DO BMES^XPDUTL(" ")
+4 SET ZTRTN="F7203Q^EC2P16PT"
SET ZTDESC="File #720.3 Review from EC*2*16"
SET ZTIO=""
+5 SET ZTDTH=$HOROLOG
SET ZTREQ="@"
SET ZTSAVE("ZTREQ")=""
DO ^%ZTLOAD
+6 QUIT
+7 ;
F7203Q ;* background job entry point
+1 NEW ECPTR,ECPROCT,EC01,ECSCDA,ECFILE,ECDATA,ECLOC,ECCAT,ECCATNM,ECUNIT,ECWORD,ECNAM,ECPROC,ECINACT,COUNT,TXTVAR
+2 SET COUNT=0
KILL ^TMP($JOB,"EC2P16")
+3 FOR I=1:1
SET TXTVAR=$PIECE($TEXT(MSGTXT+I),";;",2)
if TXTVAR="QUIT"
QUIT
DO LINE(TXTVAR)
+4 SET (EC01,ECPROCT)=0
+5 FOR
SET EC01=$ORDER(^ECJ("B",EC01))
if +EC01=0
QUIT
Begin DoDot:1
+6 SET ECPTR=$PIECE(EC01,"-",4)
+7 SET ECSCDA=$ORDER(^ECJ("B",EC01,0))
+8 if '$DATA(^ECJ(ECSCDA,0))
QUIT
+9 ;ignore any ec screen inactivated before this fiscal year
+10 IF +$PIECE(^ECJ(ECSCDA,0),"^",2)
if +$PIECE(^ECJ(ECSCDA,0),"^",2)<2981000
QUIT
+11 SET ECWORD=""
IF ($PIECE(^ECJ(ECSCDA,0),"^",2)'="")&(+$PIECE(^ECJ(ECSCDA,0),"^",2)<DT)
SET ECWORD="*inactive* "
+12 SET ECFILE=$PIECE(ECPTR,";",2)
+13 ;ec screens pointing to file #725
+14 IF ECFILE["EC(725"
SET ECDATA=$GET(^EC(725,$PIECE(ECPTR,";",1),0))
Begin DoDot:2
+15 SET ECINACT=$PIECE(ECDATA,U,3)
+16 if ECINACT=""
QUIT
+17 ;ignore if procedure inactivated before this fiscal year
+18 if (ECINACT<2981000)
QUIT
+19 SET Y=ECINACT
DO DD^%DT
SET ECINACT=Y
+20 SET ECLOC=$PIECE(EC01,"-",1)
+21 SET ECUNIT=$PIECE(EC01,"-",2)
+22 SET ECCAT=$PIECE(EC01,"-",3)
+23 SET ECLOC=$PIECE($GET(^DIC(4,ECLOC,0)),U,1)
+24 SET ECUNIT=$PIECE($GET(^ECD(ECUNIT,0)),U,1)
+25 if +ECCAT'=0
SET ECCATNM=$PIECE($GET(^EC(726,ECCAT,0)),U,1)
+26 if +ECCAT=0
SET ECCATNM="None"
+27 SET ECPROC=$PIECE(ECDATA,U,1)_" ("_$PIECE(ECDATA,U,2)_")"
SET ECNAM=$PIECE(^ECJ(ECSCDA,0),";",1)
+28 DO LINE(" ")
+29 DO LINE(" The National Procedure for the following "_ECWORD_"Event Code")
+30 DO LINE(" Screen ("_ECNAM_") is inactive or will soon be inactive --")
+31 DO LINE(" Location: "_ECLOC)
+32 DO LINE(" Category: "_ECCATNM)
+33 DO LINE(" DSS Unit: "_ECUNIT)
+34 DO LINE(" Procedure: "_ECPROC)
+35 DO LINE(" Inactivation Date: "_ECINACT)
+36 SET ECPROCT=ECPROCT+1
End DoDot:2
+37 ;ec screens pointing to file #81
+38 IF ECFILE["ICPT"
SET ECDATA=$GET(^ICPT($PIECE(ECPTR,";",1),0))
Begin DoDot:2
+39 SET ECINACT=$PIECE(ECDATA,U,4)
+40 if ECINACT=""
QUIT
+41 SET ECLOC=$PIECE(EC01,"-",1)
+42 SET ECUNIT=$PIECE(EC01,"-",2)
+43 SET ECCAT=$PIECE(EC01,"-",3)
+44 SET ECLOC=$PIECE($GET(^DIC(4,ECLOC,0)),U,1)
+45 SET ECUNIT=$PIECE($GET(^ECD(ECUNIT,0)),U,1)
+46 if +ECCAT'=0
SET ECCATNM=$PIECE($GET(^EC(726,ECCAT,0)),U,1)
+47 if +ECCAT=0
SET ECCATNM="None"
+48 SET ECPROC=$PIECE(ECDATA,U,2)_" ("_$PIECE(ECDATA,U,1)_")"
SET ECNAM=$PIECE(^ECJ(ECSCDA,0),";",1)
+49 DO LINE(" ")
+50 DO LINE(" The CPT procedure for the following"_ECWORD_" Event")
+51 DO LINE(" Code Screen ("_ECNAM_") is inactive --")
+52 DO LINE(" Location: "_ECLOC)
+53 DO LINE(" Category: "_ECCATNM)
+54 DO LINE(" DSS Unit: "_ECUNIT)
+55 DO LINE(" Procedure: "_ECPROC)
+56 SET ECPROCT=ECPROCT+1
End DoDot:2
End DoDot:1
+57 IF ECPROCT=0
Begin DoDot:1
+58 DO LINE(" ")
+59 DO LINE("No Event Code Screens were found to be associated with inactive")
+60 DO LINE("National Procedures or inactive CPT codes.")
End DoDot:1
+61 IF ECPROCT>0
Begin DoDot:1
+62 DO LINE(" ")
+63 DO LINE(" "_ECPROCT_" Event Code Screens were found to be pointing to an inactive")
+64 DO LINE(" or soon to be inactive procedure in file #725 or file #81.")
+65 DO LINE(" ")
End DoDot:1
+66 DO MAIL
+67 KILL ^TMP($JOB,"EC2P16")
+68 QUIT
+69 ;
LINE(TEXT) ; Add line to message global
+1 SET COUNT=COUNT+1
SET ^TMP($JOB,"EC2P16",COUNT)=TEXT
+2 QUIT
+3 ;
MAIL ; Send message
+1 NEW XMDUZ,XMY,XMTEXT,XMSUB
+2 SET XMY(DUZ)=""
SET XMDUZ=.5
+3 SET XMSUB="Event Code Screens to Review"
+4 SET XMTEXT="^TMP($J,""EC2P16"","
+5 DO ^XMD
+6 QUIT
