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

EC2P6PST.m

Go to the documentation of this file.
  1. EC2P6PST ;ALB/GTS - PATCH EC*2.0*6 Post-Init Rtn ; 9/2/97
  1. ;;2.0; EVENT CAPTURE ;**6**;8 May 96
  1. ;
  1. TEXT ; Install desc.
  1. ;; This part of the install walks through Event Capture Screens to check
  1. ;; for the existence of pointers to inactivated National Procedures.
  1. ;; A mail message is then sent indicating those screens which point
  1. ;; to inactivated National Procedures. This message should be forwarded
  1. ;; to Event Capture users responsible for management of Event Code
  1. ;; Screens.
  1. ;;QUIT
  1. ;
  1. MSGTXT ; Message intro
  1. ;; This message indicates the Event Code Screens which now point to
  1. ;; inactive National Procedures. The user should use the Inactivate
  1. ;; Event Code Screens [ECDSINAC] option to inactivate the screens
  1. ;; indicated and, when appropriate, create new screens which include a
  1. ;; respective substitute for the National Procedure which has been
  1. ;; inactivated.
  1. ;;QUIT
  1. ;
  1. POST ; Entry point
  1. ;* If 725 converted, write message
  1. I $$GET1^DID(725,"","","PACKAGE REVISION DATA")["EC*2*6" DO
  1. .D MES^XPDUTL(" ")
  1. .D MES^XPDUTL("National Procedure file (#725) previously updated.")
  1. .D MES^XPDUTL(" ")
  1. ;* Convert DSS Unit, DSS ID
  1. I $$GET1^DID(725,"","","PACKAGE REVISION DATA")'["EC*2*6" D ENTCNV
  1. Q
  1. ;
  1. ENTCNV ; Convert DSS Unit, Associated DSS ID
  1. N I,TXTVAR,ECGOODDA,ECBADDA,ECDARES,ECPTRCHK,ECGOODPT,ECVRRV
  1. D BMES^XPDUTL("Updating the National Procedures file (#725)...")
  1. D MES^XPDUTL(" ")
  1. ;
  1. D EN^EC725UPD ;*Update National Procedures
  1. ;
  1. ;*Get duplicate entry and inactivate both
  1. S ECDARES=$$GETDA("AURAL REHAB STATUS EXAM, 15 MIN","") ;*Get #725 IENs
  1. S ECGOODDA=$P(ECDARES,"^",2)
  1. S ECBADDA=$P(ECDARES,"^",3)
  1. S ECPTRCHK=ECBADDA_";EC(725," ;** Bad variable pointer value
  1. S ECGOODPT=ECGOODDA_";EC(725," ;** Good variable pointer value
  1. ;
  1. D SETTMP^EC725CHG ;** Set ^TMP global of procedures inactivated
  1. ;
  1. ;** Inactivate the duplicate entry in the National Procedure file (725)
  1. I +ECBADDA>0 DO
  1. .S DIE="^EC(725,",DA=ECBADDA,DR="2////^S X=2970831"
  1. .D ^DIE
  1. .K DIE,DA,DR
  1. ;
  1. ;** Inactivate the original entry in the National Procedure file (725)
  1. I +ECGOODDA>0 DO
  1. .S DIE="^EC(725,",DA=ECGOODDA,DR="2////^S X=2970831"
  1. .D ^DIE
  1. .K DIE,DA,DR
  1. ;
  1. D MES^XPDUTL(" "),MES^XPDUTL(" ")
  1. F I=1:1 S TXTVAR=$P($T(TEXT+I),";;",2) Q:TXTVAR="QUIT" DO
  1. .S:TXTVAR="" TXTVAR=" "
  1. .D MES^XPDUTL(TXTVAR)
  1. D F7203INS ;*Report EC Screens pointing to inactive National Procedures
  1. ;
  1. S ECVRRV=$$GET1^DID(725,"","","PACKAGE REVISION DATA")
  1. S ECVRRV=ECVRRV_"^EC*2*6"
  1. D PRD^DILFD(725,ECVRRV) ;*Set VRRV node (file #725)
  1. ;
  1. D KVARS
  1. Q
  1. ;
  1. F7203INS ;* Inspect/Report 720.3
  1. D BMES^XPDUTL("Inspecting EC Event Code Screens file (#720.3)...")
  1. ;
  1. ;** Inspect Variable Pointers
  1. N ECPTR,ECPROCT,EC01,COUNT
  1. N I,TXTVAR,ECLOC,ECUNIT,ECCAT,ECCATNM,ECPROC,ECSCDA
  1. S COUNT=0
  1. D LINE(" "),LINE(" ")
  1. F I=1:1 S TXTVAR=$P($T(MSGTXT+I),";;",2) Q:TXTVAR="QUIT" DO
  1. .S:TXTVAR="" TXTVAR=" "
  1. .D LINE(TXTVAR)
  1. S (EC01,ECPROCT)=0
  1. F S EC01=$O(^ECJ("B",EC01)) Q:+EC01=0 DO
  1. .S ECPTR=$P(EC01,"-",4)
  1. .S ECSCDA=$O(^ECJ("B",EC01,0))
  1. .I $D(^TMP($J,"EC*2*6 INACTIVE PROC",ECPTR)) DO
  1. ..I $P(^ECJ(ECSCDA,0),"^",2)>DT!($P(^ECJ(ECSCDA,0),"^",2)="") DO
  1. ...D LINE(" ")
  1. ...S ECLOC=$P(EC01,"-",1)
  1. ...S ECUNIT=$P(EC01,"-",2)
  1. ...S ECCAT=$P(EC01,"-",3)
  1. ...S ECLOC=$P($G(^DIC(4,ECLOC,0)),"^",1)
  1. ...S ECUNIT=$P($G(^ECD(ECUNIT,0)),"^",1)
  1. ...S:+ECCAT'=0 ECCATNM=$P($G(^EC(726,ECCAT,0)),"^",1)
  1. ...S:+ECCAT=0 ECCATNM="None"
  1. ...S ECPROC=$P($G(^EC(725,$P(ECPTR,";",1),0)),"^",1)
  1. ...D LINE(" ")
  1. ...D LINE(" The procedure for the following Event Code Screen has been inactivated.")
  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 DO
  1. .D LINE(" ")
  1. .D LINE("No Event Code Screens were identified as associated with newly inactivated")
  1. .D LINE("National Procedures.")
  1. D MAIL
  1. D MES^XPDUTL(" ")
  1. D MES^XPDUTL(ECPROCT_" Event Code Screens pointing to inactive procedures identified and ")
  1. D MES^XPDUTL("message sent.")
  1. Q
  1. ;
  1. KVARS K ^TMP($J,"EC*2*6 INACTIVE PROC")
  1. Q
  1. ;
  1. GETDA(ECNAME,ECNUM) ; Get IENs for duplicate entries in 725
  1. ; Input:
  1. ; ECNAME - The name of the National Procedure to search for a duplicate
  1. ; ECNUM - The National Number of the procedure to search
  1. ;
  1. ; Output:
  1. ; ECDAS - Indicates if a duplicate entry was found and the IENs of
  1. ; the original and duplicate entry
  1. ; Values
  1. ; -1 : Entry was not found in National Procedure file
  1. ; 0^ien : A single active entry was found (ien returned)
  1. ; 1^ien^ien : Duplicate active entries found (iens returned)
  1. ;
  1. ; Note: If both Name and number are received the Name is searched and
  1. ; number ignored
  1. ;
  1. N ECDAS,ECNPIEN,ECLPQT
  1. S ECDAS=-1
  1. S (ECLPQT,ECNPIEN)=0
  1. I ECNAME'="" DO
  1. .F S ECNPIEN=$O(^EC(725,"B",ECNAME,ECNPIEN)) Q:+ECNPIEN=0 Q:ECLPQT DO
  1. ..I $P(^EC(725,ECNPIEN,0),"^",3)>DT!($P(^EC(725,ECNPIEN,0),"^",3)="") DO
  1. ...I +ECDAS=0 S ECDAS="1^"_$P(ECDAS,"^",2)_"^"_ECNPIEN S ECLPQT=1
  1. ...S:ECDAS=-1 ECDAS="0^"_ECNPIEN
  1. I ECNUM'="",ECNAME="" DO
  1. .F S ECNPIEN=$O(^EC(725,"D",ECNUM,ECNPIEN)) Q:+ECNPIEN=0 Q:ECLPQT DO
  1. ..I $P(^EC(725,ECNPIEN,0),"^",3)>DT!($P(^EC(725,ECNPIEN,0),"^",3)="") DO
  1. ...I +ECDAS=0 S ECDAS="1^"_$P(ECDAS,"^",2)_"^"_ECNPIEN S ECLPQT=1
  1. ...S:ECDAS=-1 ECDAS="0^"_ECNPIEN
  1. Q ECDAS
  1. ;
  1. MAIL ; Send message
  1. N DIFROM
  1. S XMY(DUZ)="",XMDUZ=.5
  1. S XMSUB="Event Code Screens to review"
  1. S XMTEXT="^TMP(""EC V2.0 P6 INSTALL MSG"","_$J_","
  1. D ^XMD
  1. K XMDUZ,XMY,XMTEXT,XMSUB
  1. K ^TMP("EC V2.0 P6 INSTALL MSG",$J)
  1. Q
  1. ;
  1. LINE(TEXT) ; Add line to message global
  1. S COUNT=COUNT+1,^TMP("EC V2.0 P6 INSTALL MSG",$J,COUNT)=TEXT
  1. Q