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

ECX3P120.m

Go to the documentation of this file.
  1. ECX3P120 ;ALB/JAP - DSS FY2010 Conversion, Post-init ; 6/18/09 9:51am
  1. ;;3.0;DSS EXTRACTS;**120**;Dec 22, 1997;Build 43
  1. ;
  1. ;****************************************
  1. ;Every year: Populate FY Year's version
  1. ; TESTON^ECXTREX(XPDNM,"FY2010")
  1. ;****************************************
  1. ;
  1. POST ;post-init
  1. D TEST,OPT
  1. N ECXI
  1. ;add observation treating specialty
  1. TS F ECXI=1:1 S ECXOTS=$P($T(OTSP+ECXI),";;",2) Q:ECXOTS="QUIT" D
  1. .D OTS
  1. Q
  1. ;
  1. TEST ;turn-on fld #73 in file #728 for Field Test Site;
  1. ;allows use of option ECX FISCAL YEAR EXTRACT by test sites;
  1. D MES^XPDUTL(" ")
  1. D MES^XPDUTL("Providing special menu option access for DSS FY Conversion test sites.")
  1. D TESTON^ECXTREX(XPDNM,"FY2010")
  1. ;D MES^XPDUTL(" ")
  1. ;D MES^XPDUTL("Remember to assign the ECX DSS TEST key to qualified users.")
  1. D MES^XPDUTL(" ")
  1. ;if this is the national released version, then fld #73 will be turned-off
  1. ;the first time any user attempts to use ECX FISCAL YEAR EXTRACT option;
  1. ;
  1. ;initialize new field # in file #728.44;
  1. N EC,ECD,X
  1. S EC=0 F S EC=$O(^SC(EC)) Q:'EC D
  1. .I $D(^SC(EC,0)) S ECD=^(0) I $P(ECD,U,3)="C" D
  1. ..S X=$P(ECD,U,17) I X'="" I $D(^ECX(728.44,EC,0)) S $P(^ECX(728.44,EC,0),U,12)=X
  1. Q
  1. OPT ;delete ECX LBB SOURCE AUDIT from ECX SOURCE AUDITS
  1. ;
  1. D MES^XPDUTL("...Cleaning up ECX SOURCE AUDITS menu")
  1. N DIC,Y
  1. S DIC="^DIC(19,",DIC(0)="MBX",X="ECX SOURCE AUDITS" D ^DIC Q:+Y<0
  1. S DA(1)=+Y
  1. S DIC="^DIC(19,"_DA(1)_",10,",DIC(0)="MBX",X="ECX LBB SOURCE AUDIT" D ^DIC Q:+Y<0
  1. S DA=+Y
  1. S DIK="^DIC(19,"_DA(1)_",10," D ^DIK
  1. Q
  1. OTS ;Add Observation Treating Specialty to DSS TREATING SPECIALTY TRANSLATION File (#727.831)
  1. D BMES^XPDUTL(">>>"_$P(ECXOTS,U,2)_">>>")
  1. N DA,ECXFILE,DIC,DIE,DINUM,DLAYGO,DR,X,Y
  1. S ECXERR=0
  1. S DIC="^ECX(727.831,"
  1. S DIC(0)="LX"
  1. S DINUM=$P(ECXOTS,U)
  1. S X=$P(ECXOTS,U,2)
  1. S DLAYGO=727.831
  1. D ^DIC
  1. S ECXIFN=Y
  1. I +ECXIFN=-1 D Q
  1. .D MES^XPDUTL(" Entry not added to DSS TREATING SPECIALTY TRANSLATION File (#727.831). No further updating will occur.")
  1. .D MES^XPDUTL(" Please contact Customer Service for assistance.")
  1. .Q
  1. I $P(ECXIFN,U,3)'=1&(+ECXIFN'=$P(ECXOTS,U)) D Q
  1. .D MES^XPDUTL(" Entry exists in DSS TREATING SPECIALTY TRANSLATION File (#727.831), but with a different Treating Specialty.")
  1. .D MES^XPDUTL(" No further updating will occur. Please review entry.")
  1. .S ECXERR=1
  1. .Q
  1. D MES^XPDUTL(" Entry "_$S($P(ECXIFN,U,3)=1:"added to",1:"exists in")_" DSS TREATING SPECIALTY TRANSLATION File (#727.831).")
  1. D MES^XPDUTL(" Updating DSS TREATING SPECIALTY TRANSLATION File fields.")
  1. S DIE=DIC
  1. S DR="4///"_$P(ECXOTS,U,3)_";5///"_$P(ECXOTS,U,4)_";6///"_$P(ECXOTS,U,5)
  1. S DA=+ECXIFN
  1. D ^DIE
  1. Q
  1. OTSP ;Treating Specialty #^Treating Specialty Name^Observation Pat Indicator^Inpat Outpat Code^Observation Stop Code
  1. ;;108^ED OBSERVATION^Y^O^297
  1. ;;QUIT
  1. Q