- EC2P21PT ;ALB/GTS/JAP/JAM - PATCH EC*2.0*21 Post-Init Rtn ; 10/1/99
- ;;2.0; EVENT CAPTURE ;**21**;8 May 96
- ;
- POST ; entry point
- N ECVRRV
- ;* check if patch EC*2.0*20 was installed then evaluate file 720.3
- ; If not installed write message.
- I $$GET1^DID(725,"","","PACKAGE REVISION DATA")["EC*2*20" D Q
- .D MES^XPDUTL(" ")
- .D MES^XPDUTL("This patch is a follow-up to patch EC*2*20. It")
- .D MES^XPDUTL("checks EC EVENT CODE SCREENS file #720.3 for")
- .D MES^XPDUTL("event code screens that would need to be inactivated")
- .D MES^XPDUTL("as a result of installing patch EC*2*20.")
- .D MES^XPDUTL(" ")
- .D ENTUP
- .D F7203
- D MES^XPDUTL(" ")
- D MES^XPDUTL("Patch EC*2*20 MUST be installed before running this")
- D MES^XPDUTL("patch, EC*2*21.")
- Q
- ;
- ENTUP ;
- ;* set vrrv node (file #725)
- S ECVRRV=$$GET1^DID(725,"","","PACKAGE REVISION DATA")
- S ECVRRV=ECVRRV_"^EC*2*21"
- D PRD^DILFD(725,ECVRRV)
- Q
- ;
- MSGTXT ; Message intro
- ;; Please forward this message to your local DSS Site Manager or
- ;; Event Capture ADPAC.
- ;;
- ;; Patch EC*2*20 has updated the EC NATIONAL PROCEDURE file (#725) and
- ;; a review of the EC EVENT CODE SCREENS file (#720.3) has been done
- ;; by patch EC*2*21. 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^EC2P21PT",ZTDESC="File #720.3 Review from EC*2*21",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,ECNAM,ECPROC,ECINACT,COUNT,TXTVAR
- S COUNT=0 K ^TMP($J,"EC2P21")
- 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 that has been inactivated
- .Q:+$P(^ECJ(ECSCDA,0),"^",2)
- .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<2991000)
- ..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 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 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,"EC2P21"),I,Y
- Q
- ;
- LINE(TEXT) ; Add line to message global
- S COUNT=COUNT+1,^TMP($J,"EC2P21",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,""EC2P21"","
- D ^XMD
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEC2P21PT 4978 printed Jan 18, 2025@02:57:05 Page 2
- EC2P21PT ;ALB/GTS/JAP/JAM - PATCH EC*2.0*21 Post-Init Rtn ; 10/1/99
- +1 ;;2.0; EVENT CAPTURE ;**21**;8 May 96
- +2 ;
- POST ; entry point
- +1 NEW ECVRRV
- +2 ;* check if patch EC*2.0*20 was installed then evaluate file 720.3
- +3 ; If not installed write message.
- +4 IF $$GET1^DID(725,"","","PACKAGE REVISION DATA")["EC*2*20"
- Begin DoDot:1
- +5 DO MES^XPDUTL(" ")
- +6 DO MES^XPDUTL("This patch is a follow-up to patch EC*2*20. It")
- +7 DO MES^XPDUTL("checks EC EVENT CODE SCREENS file #720.3 for")
- +8 DO MES^XPDUTL("event code screens that would need to be inactivated")
- +9 DO MES^XPDUTL("as a result of installing patch EC*2*20.")
- +10 DO MES^XPDUTL(" ")
- +11 DO ENTUP
- +12 DO F7203
- End DoDot:1
- QUIT
- +13 DO MES^XPDUTL(" ")
- +14 DO MES^XPDUTL("Patch EC*2*20 MUST be installed before running this")
- +15 DO MES^XPDUTL("patch, EC*2*21.")
- +16 QUIT
- +17 ;
- ENTUP ;
- +1 ;* set vrrv node (file #725)
- +2 SET ECVRRV=$$GET1^DID(725,"","","PACKAGE REVISION DATA")
- +3 SET ECVRRV=ECVRRV_"^EC*2*21"
- +4 DO PRD^DILFD(725,ECVRRV)
- +5 QUIT
- +6 ;
- MSGTXT ; Message intro
- +1 ;; Please forward this message to your local DSS Site Manager or
- +2 ;; Event Capture ADPAC.
- +3 ;;
- +4 ;; Patch EC*2*20 has updated the EC NATIONAL PROCEDURE file (#725) and
- +5 ;; a review of the EC EVENT CODE SCREENS file (#720.3) has been done
- +6 ;; by patch EC*2*21. This message provides the results of that review.
- +7 ;;
- +8 ;; The EC EVENT CODE SCREENS file (#720.3) records indicated below
- +9 ;; point to an inactive record in the EC NATIONAL PROCEDURE file
- +10 ;; (#725) or to an inactive record in the CPT file (#81).
- +11 ;;
- +12 ;; The user should use the Inactivate Event Code Screens [ECNACT]
- +13 ;; option to inactivate the Event Code Screen. If necessary, a new
- +14 ;; Event Code Screen can be created using a currently active CPT code
- +15 ;; or National Procedure.
- +16 ;;
- +17 ;;QUIT
- +18 ;
- 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^EC2P21PT"
- SET ZTDESC="File #720.3 Review from EC*2*21"
- 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,ECNAM,ECPROC,ECINACT,COUNT,TXTVAR
- +2 SET COUNT=0
- KILL ^TMP($JOB,"EC2P21")
- +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 that has been inactivated
- +10 if +$PIECE(^ECJ(ECSCDA,0),"^",2)
- QUIT
- +11 SET ECFILE=$PIECE(ECPTR,";",2)
- +12 ;ec screens pointing to file #725
- +13 IF ECFILE["EC(725"
- SET ECDATA=$GET(^EC(725,$PIECE(ECPTR,";",1),0))
- Begin DoDot:2
- +14 SET ECINACT=$PIECE(ECDATA,U,3)
- +15 if ECINACT=""
- QUIT
- +16 ;ignore if procedure inactivated before this fiscal year
- +17 if (ECINACT<2991000)
- QUIT
- +18 SET Y=ECINACT
- DO DD^%DT
- SET ECINACT=Y
- +19 SET ECLOC=$PIECE(EC01,"-",1)
- +20 SET ECUNIT=$PIECE(EC01,"-",2)
- +21 SET ECCAT=$PIECE(EC01,"-",3)
- +22 SET ECLOC=$PIECE($GET(^DIC(4,ECLOC,0)),U,1)
- +23 SET ECUNIT=$PIECE($GET(^ECD(ECUNIT,0)),U,1)
- +24 if +ECCAT'=0
- SET ECCATNM=$PIECE($GET(^EC(726,ECCAT,0)),U,1)
- +25 if +ECCAT=0
- SET ECCATNM="None"
- +26 SET ECPROC=$PIECE(ECDATA,U,1)_" ("_$PIECE(ECDATA,U,2)_")"
- SET ECNAM=$PIECE(^ECJ(ECSCDA,0),";",1)
- +27 DO LINE(" ")
- +28 DO LINE(" The National Procedure for the following Event Code")
- +29 DO LINE(" Screen ("_ECNAM_") is inactive or will soon be inactive --")
- +30 DO LINE(" Location: "_ECLOC)
- +31 DO LINE(" Category: "_ECCATNM)
- +32 DO LINE(" DSS Unit: "_ECUNIT)
- +33 DO LINE(" Procedure: "_ECPROC)
- +34 DO LINE(" Inactivation Date: "_ECINACT)
- +35 SET ECPROCT=ECPROCT+1
- End DoDot:2
- +36 ;ec screens pointing to file #81
- +37 IF ECFILE["ICPT"
- SET ECDATA=$GET(^ICPT($PIECE(ECPTR,";",1),0))
- Begin DoDot:2
- +38 SET ECINACT=$PIECE(ECDATA,U,4)
- +39 if ECINACT=""
- QUIT
- +40 SET ECLOC=$PIECE(EC01,"-",1)
- +41 SET ECUNIT=$PIECE(EC01,"-",2)
- +42 SET ECCAT=$PIECE(EC01,"-",3)
- +43 SET ECLOC=$PIECE($GET(^DIC(4,ECLOC,0)),U,1)
- +44 SET ECUNIT=$PIECE($GET(^ECD(ECUNIT,0)),U,1)
- +45 if +ECCAT'=0
- SET ECCATNM=$PIECE($GET(^EC(726,ECCAT,0)),U,1)
- +46 if +ECCAT=0
- SET ECCATNM="None"
- +47 SET ECPROC=$PIECE(ECDATA,U,2)_" ("_$PIECE(ECDATA,U,1)_")"
- SET ECNAM=$PIECE(^ECJ(ECSCDA,0),";",1)
- +48 DO LINE(" ")
- +49 DO LINE(" The CPT procedure for the following Event")
- +50 DO LINE(" Code Screen ("_ECNAM_") is inactive --")
- +51 DO LINE(" Location: "_ECLOC)
- +52 DO LINE(" Category: "_ECCATNM)
- +53 DO LINE(" DSS Unit: "_ECUNIT)
- +54 DO LINE(" Procedure: "_ECPROC)
- +55 SET ECPROCT=ECPROCT+1
- End DoDot:2
- End DoDot:1
- +56 IF ECPROCT=0
- Begin DoDot:1
- +57 DO LINE(" ")
- +58 DO LINE("No Event Code Screens were found to be associated with inactive")
- +59 DO LINE("National Procedures or inactive CPT codes.")
- End DoDot:1
- +60 IF ECPROCT>0
- Begin DoDot:1
- +61 DO LINE(" ")
- +62 DO LINE(" "_ECPROCT_" Event Code Screens were found to be pointing to an inactive")
- +63 DO LINE(" or soon to be inactive procedure in file #725 or file #81.")
- +64 DO LINE(" ")
- End DoDot:1
- +65 DO MAIL
- +66 KILL ^TMP($JOB,"EC2P21"),I,Y
- +67 QUIT
- +68 ;
- LINE(TEXT) ; Add line to message global
- +1 SET COUNT=COUNT+1
- SET ^TMP($JOB,"EC2P21",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,""EC2P21"","
- +5 DO ^XMD
- +6 QUIT