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

DG53819B.m

Go to the documentation of this file. 
  1. DG53819B ;ALB/MJB - TREATING SPECIALTIES UPDATES ; 3/12/07 7:21am
  1.  ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
  1.  ;
  1.  Q
  1. EN ;Add Treating Specialties to the SPECIALITY file (#42.4)
  1.  N DGI,DGERR,DGSPEC,DGIFN,DGQUES
  1.  S DGIFN=0
  1.  ;add new treating specialties
  1.  F DGI=1:1 S DGSPEC=$P($T(TRSP+DGI),";;",2) Q:DGSPEC="QUIT"  D
  1.  .D TSPEC
  1.  .S DGQUES=$P(DGSPEC,U,9)
  1.  .D FAC
  1.  .Q
  1.  ;edit existing treating specialties
  1.  ;D EDIT
  1.  ;inactivate existing treating specialties
  1.  D INACT
  1.  ;edit existing surgical specialties
  1.  ;D EDIT^DG53813R
  1.  Q
  1. TSPEC ;Add treating specialty to SPECIALTY File (#42.4)
  1.  D BMES^XPDUTL(">>>"_$P(DGSPEC,U,2)_">>>")
  1.  N DA,DGFILE,DGMULT,DIC,DIE,DGDA1,DINUM,DLAYGO,DR,X,Y
  1.  ;S DGERR=0
  1.  S DIC="^DIC(42.4,"
  1.  S DIC(0)="LX"
  1.  S DINUM=$P(DGSPEC,U)
  1.  S X=$P(DGSPEC,U,2)
  1.  S DLAYGO=42.4
  1.  D ^DIC
  1.  S (DGIFN,DGDA1)=DGSPEC
  1.  I +DGIFN=-1 D  Q
  1.  .D MES^XPDUTL("     Entry not added to SPECIALTY File (#42.4).  No further updating will occur.")
  1.  .D MES^XPDUTL("     Please contact Customer Service for assistance.")
  1.  .Q
  1.  ;I $P(DGIFN,U,3)'=1&(+DGIFN'=$P(DGSPEC,U)) D  Q
  1.  ;.D MES^XPDUTL("     Entry exists in SPECIALTY File (#42.4), but with a different PTF Code #.")
  1.  ;.D MES^XPDUTL("     No further updating will occur.  Please review entry.")
  1.  ;.S DGERR=1
  1.  ;.Q 
  1.  D MES^XPDUTL("     Entry added to SPECIALTY File (#42.4).")
  1.  D MES^XPDUTL("     Updating SPECIALTY File fields.")
  1.  S DIE=DIC
  1.  S DR=".01///"_$P(DGSPEC,U,2)_";1///"_$P(DGSPEC,U,3)_";3///"_$P(DGSPEC,U,4)_";4///"_$P(DGSPEC,U,5)_";5///"_$P(DGSPEC,U,6)_";6///"_$P(DGSPEC,U,7)_";7///"_$P(DGSPEC,U,10)
  1.  S DA=+DGIFN
  1.  D ^DIE
  1.  S DGFILE=42.4
  1.  S DGMULT=10
  1.  S DIC="^DIC(42.4,"_+DGIFN_",""E"","
  1.  D MULT
  1.  Q
  1. FAC ;Add treating specialty to Facility Treating Specialty file (#45.7)
  1.  N DA,DGFILE,DGMULT,DIC,DIE,DLAYGO,DR,X,Y
  1.  S DIC="^DIC(45.7,"
  1.  S DIC(0)="LXZ"
  1.  S DLAYGO=45.7
  1.  S X=$P(DGSPEC,U,2)
  1.  D ^DIC
  1.  S DGDA1=Y
  1.  I +DGDA1=-1 D BMES^XPDUTL("     Entry not added to FACILITY TREATING SPECIALTY File(#45.7).") Q
  1.  I $P(DGDA1,U,3)'=1&($P(Y(0),U,2)'=$P(DGSPEC,U)) D  Q
  1.  .D BMES^XPDUTL("     Entry exists in FACILITY TREATING SPECIALTY File (#45.7), but with")
  1.  .D MES^XPDUTL("     a different PTF Code #.  No further updating will occur.")
  1.  .D MES^XPDUTL("     Please review entry.")
  1.  .Q
  1.  D BMES^XPDUTL("     Entry "_$S($P(DGDA1,U,3)=1:"added to",1:"exists in")_" FACILITY TREATING SPECIALTY File (#45.7).")
  1.  D MES^XPDUTL("     Updating SPECIALTY field...")
  1.  S DIE=DIC
  1.  S DA=+DGDA1
  1.  S DR="1////"_$P(DGSPEC,U)
  1.  D ^DIE
  1.  S DGFILE=45.7
  1.  S DGMULT=100
  1.  S DIC="^DIC(45.7,"_+DGDA1_",""E"","
  1.  D MULT
  1.  Q
  1. MULT ;Add Effective Date
  1.  N DA,DIE,DR
  1.  S DA(1)=+DGDA1
  1.  S DIC(0)="LX"
  1.  S DIC("P")=$P(^DD(DGFILE,DGMULT,0),"^",2)
  1.  S X=3100101
  1.  D ^DIC
  1.  S DA=+Y
  1.  I +Y=-1 D MES^XPDUTL("     Effective date not added.") Q
  1.  D MES^XPDUTL("     Effective date added.")
  1.  S DIE=DIC
  1.  S DR=".02///Y"
  1.  D ^DIE
  1.  Q
  1. INACT ;inactivate treating specialties
  1.  N DA,DIE,DR,X,DGTSP
  1.  F DGTSP=36,62 D
  1.  . S DIC="^DIC(42.4,"_DGTSP_",""E"","
  1.  . S DA(1)=DGTSP
  1.  . S DIC(0)="LX"
  1.  . S DIC("P")=$P(^DD(42.4,10,0),"^",2)
  1.  . S X=3100601
  1.  . D ^DIC
  1.  . S DA=+Y
  1.  . I +Y=-1 D BMES^XPDUTL(">>>Inactive date not added to TS code "_DGTSP_" in the Specialty file.<<<") Q
  1.  . D BMES^XPDUTL(">>>Inactive date added to TS code "_DGTSP_" in the Specialty file.<<<")
  1.  . S DIE=DIC
  1.  . S DR=".02///N"
  1.  . D ^DIE
  1.  . ;check for CODES in the Facility Treating Specialty File (45.7
  1.  . ;add inactivation date of 2/1/2010
  1.  . D BMES^XPDUTL("  ")
  1.  . D MES^XPDUTL("     FACILITY TREATING SPECIALTY FILE being checked to see if any entries are")
  1.  . D MES^XPDUTL("     pointing to "_DGTSP_".  If so, they will be inactivated.>>>")
  1.  .N DAA F DAA=0:0 S DAA=$O(^DIC(45.7,"ASPEC",DGTSP,DAA)) Q:'DAA  D
  1.  .. N DIE,DR,TS,X S TS=""
  1.  ..S TS=$P($G(^DIC(45.7,DAA,0)),"^")
  1.  ..S DIC="^DIC(45.7,"_DAA_",""E"","
  1.  ..S DA(1)=DAA
  1.  ..S DIC(0)="LX"
  1.  ..S X=3100601
  1.  ..D ^DIC
  1.  ..S DA=+Y
  1.  ..I +Y=-1 D BMES^XPDUTL("     Inactive date not added to "_TS_"in the Facility Treating Specialty file.") Q
  1.  ..D BMES^XPDUTL("     Inactive date added to "_TS_" in the Facility Treating Specialty file.<<<")
  1.  ..S DIE=DIC
  1.  ..S DR=".02///N"
  1.  ..D ^DIE
  1.  Q
  1. EDIT ;Edit treating specialties
  1.  ;
  1.  N DS,DIE,DR,DGI
  1.  S DIE="^DIC(42.4,"
  1.  S DIC(0)="LX"
  1.  F DGI=1:1 S DGSPEC=$P($T(ETRSP+DGI),";;",2) Q:DGSPEC="QUIT"  D
  1.  . S DGERR=0
  1.  . S DA=$P(DGSPEC,U)
  1.  . S DR=".01///"_$P(DGSPEC,U,2)_";1///"_$P(DGSPEC,U,3)_";3///"_$P(DGSPEC,U,4)_";4///"_$P(DGSPEC,U,5)_";5///"_$P(DGSPEC,U,6)_";6///"_$P(DGSPEC,U,7)
  1.  . D ^DIE
  1.  . D BMES^XPDUTL("  ")
  1.  . D BMES^XPDUTL("  ")
  1.  . D BMES^XPDUTL(">>>"_$P(DGSPEC,U)_" code updated to "_$P(DGSPEC,U,2)_" in the Specialty file.>>>")
  1.  N DS,DIE,DR,DGI,DGII,DGSP,CNT,DGSPEC,DGSPEC1
  1.  S DIE="^DIC(45.7,"
  1.  S DIC(0)="LX"
  1.  F DGI=1:1 S DGSPEC=$P($T(ETRSP+DGI),";;",2) Q:DGSPEC="QUIT"  D
  1.  . S DGERR=0
  1.  . S DGSP=$P(DGSPEC,U)
  1.  . S CNT=0,DGSPEC1=0 F DGII=0:0 S DGSPEC1=$O(^DIC(45.7,"ASPEC",DGSP,DGSPEC1)) Q:'DGSPEC1  S CNT=CNT+1 D
  1.  .. I CNT=1 D
  1.  ... I $$ACTIVE^DGACT(45.7,DGSPEC1)'=1 S CNT=0 Q
  1.  ... S DA=DGSPEC1,DR=".01///"_$P(DGSPEC,U,2)_";99///@"
  1.  ... D BMES^XPDUTL("     "_$P(^DIC(45.7,DGSPEC1,0),U)_" name has been changed to "_$P(DGSPEC,U,2)_" in the Facility Treating Specialty file.")
  1.  ... D ^DIE
  1.  .. E  D
  1.  ... S TS=""
  1.  ... S TS=$P($G(^DIC(45.7,DGSPEC1,0)),"^")
  1.  ... D BMES^XPDUTL("     Please review Facility Treating Specialty "_TS_".  The entry name may need changing or entry may need inactivating since more than one entry points to "_$P(DGSPEC,U,2)_" in the Specialty file.<<<")
  1.  Q
  1. TRSP ;PTF CODE^SPECIALTY^PRINT NAME^SERVICE^ASK PSYCH^BILLING BEDSECTION^CDR/MPCR^^QUES#^AUSTIN PTF CODE
  1.  ;;112^POLYTRAUMA REHAB UNIT^^REHAB MEDICINE^N^REHABILITATION MEDICINE^1113^^^1N
  1.  ;;QUIT
  1. ETRSP ;PTF CODE^SPECIALTY^PRINT NAME^SERVICE^ASK PSYCH^BILLING BEDSECTION^CDR/MPCR
  1.  ;;QUIT