- ECP115PT ;ALB/BR - PATCH EC*2.0*115 Post-Init Rtn ; 1/19/10 2:48pm
- ;;2.0;EVENT CAPTURE;**115**;8 May 96;Build 12
- ;
- Q
- 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*115" 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*115.")
- .D MES^XPDUTL(" ")
- .D MES^XPDUTL("But the patch may be re-installed...")
- .D MES^XPDUTL(" ")
- D ENTUP
- D F7203
- D KILL1
- Q
- ;
- ENTUP ;
- D MES^XPDUTL(" ")
- D BMES^XPDUTL("Updating the National Procedures file (#725)...")
- D MES^XPDUTL(" ")
- ;* add new/edit national procedures
- D ADDPROC^EC725U62 ;add new procedures
- D NAMECHG^EC725U62 ;change description
- D CPTCHG^EC725U63 ;change CPT code
- D INACT^EC725U63 ;inactivate code
- ;D REACT^EC725U63 ;reactivate code
- ;* set VRRV node (file #725)
- S ECVRRV=$$GET1^DID(725,"","","PACKAGE REVISION DATA")
- S ECVRRV=ECVRRV_"^EC*2*115"
- 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.;; Event Capture ADPAC.
- ;;
- ;; A review of the EC EVENT CODE SCREENS file (#720.3) was done
- ;; after installation of patch EC*2*115 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^ECP115PT",ZTDESC="File #720.3 Review from EC*2*115",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,"ECP115")
- 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),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<3110104)
- ..S Y=ECINACT D DD^%DT S ECINACT=Y
- ..S ECLOC=$P(EC01,"-",1),ECUNIT=$P(EC01,"-",2),ECCAT=$P(EC01,"-",3)
- ..S ECLOC=$P($G(^DIC(4,ECLOC,0)),U,1),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)_")"
- ..S 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),ECUNIT=$P(EC01,"-",2),ECCAT=$P(EC01,"-",3)
- ..S ECLOC=$P($G(^DIC(4,ECLOC,0)),U,1),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(" "_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,"ECP115"),I,Y
- Q
- ;
- LINE(TEXT) ; Add line to message global
- S COUNT=COUNT+1,^TMP($J,"ECP115",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,""ECP115"","
- D ^XMD
- Q
- KILL1 ;
- K ZTDESC,ZTDTH,ZTIO,ZTREQ,ZTRTN,ZTSAVE("ZTREQ")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECP115PT 5213 printed Jan 18, 2025@02:59:32 Page 2
- 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
- +2 ;
- +3 QUIT
- 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*115"
- 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*115.")
- +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 DO KILL1
- +15 QUIT
- +16 ;
- ENTUP ;
- +1 DO MES^XPDUTL(" ")
- +2 DO BMES^XPDUTL("Updating the National Procedures file (#725)...")
- +3 DO MES^XPDUTL(" ")
- +4 ;* add new/edit national procedures
- +5 ;add new procedures
- DO ADDPROC^EC725U62
- +6 ;change description
- DO NAMECHG^EC725U62
- +7 ;change CPT code
- DO CPTCHG^EC725U63
- +8 ;inactivate code
- DO INACT^EC725U63
- +9 ;D REACT^EC725U63 ;reactivate code
- +10 ;* set VRRV node (file #725)
- +11 SET ECVRRV=$$GET1^DID(725,"","","PACKAGE REVISION DATA")
- +12 SET ECVRRV=ECVRRV_"^EC*2*115"
- +13 DO PRD^DILFD(725,ECVRRV)
- +14 DO MES^XPDUTL(" ")
- +15 DO BMES^XPDUTL("Update of EC NATIONAL PROCEDURE file (#725)")
- +16 DO BMES^XPDUTL(" completed...")
- +17 DO MES^XPDUTL(" ")
- +18 QUIT
- MSGTXT ; Message intro
- +1 ;; Please forward this message to your local DSS Site Manager or
- +2 ;; Event Capture ADPAC.;; 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*115 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^ECP115PT"
- SET ZTDESC="File #720.3 Review from EC*2*115"
- 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,"ECP115")
- +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)
- SET ECSCDA=$ORDER(^ECJ("B",EC01,0))
- +7 if '$DATA(^ECJ(ECSCDA,0))
- QUIT
- +8 ;ignore any ec screen that has been inactivated
- +9 if +$PIECE(^ECJ(ECSCDA,0),"^",2)
- QUIT
- +10 SET ECFILE=$PIECE(ECPTR,";",2)
- +11 ;ec screens pointing to file #725
- +12 IF ECFILE["EC(725"
- SET ECDATA=$GET(^EC(725,$PIECE(ECPTR,";",1),0))
- Begin DoDot:2
- +13 SET ECINACT=$PIECE(ECDATA,U,3)
- +14 if ECINACT=""
- QUIT
- +15 ;ignore if procedure inactivated before this fiscal year
- +16 if (ECINACT<3110104)
- QUIT
- +17 SET Y=ECINACT
- DO DD^%DT
- SET ECINACT=Y
- +18 SET ECLOC=$PIECE(EC01,"-",1)
- SET ECUNIT=$PIECE(EC01,"-",2)
- SET ECCAT=$PIECE(EC01,"-",3)
- +19 SET ECLOC=$PIECE($GET(^DIC(4,ECLOC,0)),U,1)
- SET ECUNIT=$PIECE($GET(^ECD(ECUNIT,0)),U,1)
- +20 if +ECCAT'=0
- SET ECCATNM=$PIECE($GET(^EC(726,ECCAT,0)),U,1)
- +21 if +ECCAT=0
- SET ECCATNM="None"
- +22 SET ECPROC=$PIECE(ECDATA,U,1)_" ("_$PIECE(ECDATA,U,2)_")"
- +23 SET ECNAM=$PIECE(^ECJ(ECSCDA,0),";",1)
- +24 DO LINE(" ")
- +25 DO LINE(" The National Procedure for the following Event Code")
- +26 DO LINE(" Screen ("_ECNAM_") is inactive or will soon be inactive --")
- +27 DO LINE(" Location: "_ECLOC)
- +28 DO LINE(" Category: "_ECCATNM)
- +29 DO LINE(" DSS Unit: "_ECUNIT)
- +30 DO LINE(" Procedure: "_ECPROC)
- +31 DO LINE(" Inactivation Date: "_ECINACT)
- +32 SET ECPROCT=ECPROCT+1
- End DoDot:2
- +33 ;ec screens pointing to file #81
- +34 IF ECFILE["ICPT"
- SET ECDATA=$GET(^ICPT($PIECE(ECPTR,";",1),0))
- Begin DoDot:2
- +35 SET ECINACT=$PIECE(ECDATA,U,4)
- +36 if ECINACT=""
- QUIT
- +37 SET ECLOC=$PIECE(EC01,"-",1)
- SET ECUNIT=$PIECE(EC01,"-",2)
- SET ECCAT=$PIECE(EC01,"-",3)
- +38 SET ECLOC=$PIECE($GET(^DIC(4,ECLOC,0)),U,1)
- SET ECUNIT=$PIECE($GET(^ECD(ECUNIT,0)),U,1)
- +39 if +ECCAT'=0
- SET ECCATNM=$PIECE($GET(^EC(726,ECCAT,0)),U,1)
- +40 if +ECCAT=0
- SET ECCATNM="None"
- +41 SET ECPROC=$PIECE(ECDATA,U,2)_" ("_$PIECE(ECDATA,U,1)_")"
- SET ECNAM=$PIECE(^ECJ(ECSCDA,0),";",1)
- +42 DO LINE(" ")
- +43 DO LINE(" The CPT procedure for the following Event")
- +44 DO LINE(" Code Screen ("_ECNAM_") is inactive --")
- +45 DO LINE(" Location: "_ECLOC)
- +46 DO LINE(" Category: "_ECCATNM)
- +47 DO LINE(" DSS Unit: "_ECUNIT)
- +48 DO LINE(" Procedure: "_ECPROC)
- +49 SET ECPROCT=ECPROCT+1
- End DoDot:2
- End DoDot:1
- +50 IF ECPROCT=0
- Begin DoDot:1
- +51 DO LINE(" ")
- +52 DO LINE(" "_ECPROCT_" Event Code Screens were found to be pointing to an inactive")
- +53 DO LINE(" or soon to be inactive procedure in file #725 or file #81.")
- +54 DO LINE(" ")
- End DoDot:1
- +55 DO MAIL
- +56 KILL ^TMP($JOB,"ECP115"),I,Y
- +57 QUIT
- +58 ;
- LINE(TEXT) ; Add line to message global
- +1 SET COUNT=COUNT+1
- SET ^TMP($JOB,"ECP115",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,""ECP115"","
- +5 DO ^XMD
- +6 QUIT
- KILL1 ;
- +1 KILL ZTDESC,ZTDTH,ZTIO,ZTREQ,ZTRTN,ZTSAVE("ZTREQ")
- +2 QUIT