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

DG53P844.m

Go to the documentation of this file. 
  1. DG53P844 ;ALB/MJB/RC - TREATING SPECIALTIES UPDATES ; 6/22/11 3:45pm
  1.  ;;5.3;Registration;**844**;Aug 13, 1993;Build 3
  1.  ;
  1.  Q
  1.  ;; This routine is used to add, edit and inactivate Specialties in the specialty file and
  1.  ;; edit existing surgical specialties.
  1.  ;;
  1. EN ; Changes to the SPECIALITY file (#42.4)
  1.  N DGI,DGERR,DGSPEC,DGIFN,DGQUES
  1.  ;edit existing treating specialties, if needed
  1.  D EDIT
  1.  ;inactivate existing treating specialties, if needed
  1.  D INACT
  1.  ;edit existing surgical specialties, if needed
  1.  ;D EDIT^DG53813R
  1.  Q
  1. INACT ;inactivate treating specialties
  1.  N DA,DIE,DR,X,DGTSP,DIC,Y
  1.  F DGTSP=43 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=3111001
  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 10/1/2011
  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=3111001
  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,DIC,Y
  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. ETRSP ;PTF CODE^SPECIALTY^PRINT NAME^SERVICE^ASK PSYCH^BILLING BEDSECTION^CDR/MPCR
  1.  ;;67^NH SHORT-STAY CONTINUING CARE^NH SS CONT CARE^NHCU^NO^NURSING HOME CARE^1430^^
  1.  ;;68^NH SHORT-STAY MH RECOVERY^NH SS MH RECVRY^NHCU^NO^NURSING HOME CARE^1430^^
  1.  ;;44^NH LONG-STAY CONTINUING CARE^NH LS CONT CARE^NHCU^NO^NURSING HOME CARE^1410^^
  1.  ;;45^NH LONG-STAY MH RECOVERY^NH LS MH RECVRY^NHCU^NO^NURSING HOME CARE^1410^^
  1.  ;;QUIT
  1. PTFCHK ;Check Open PTF records for TS 43
  1.  N DGPTFIEN,DGMVTIEN,DGTEXTLN,DGTEXT,DGSPCS
  1.  S DGPTFIEN="",DGTEXTLN=10,DGSPCS="                              "
  1.  ;Go through Open PTF records
  1.  F  S DGPTFIEN=$O(^DGPT("AS",0,DGPTFIEN)) Q:'DGPTFIEN  D
  1.  .;Find the newest movement
  1.  .S DGMVTIEN=9999999
  1.  .S DGMVTIEN=$O(^DGPT(DGPTFIEN,"M",DGMVTIEN),-1)
  1.  .;If the treating specialty is 43 add to the mail message
  1.  .I DGMVTIEN,$P($G(^DGPT(DGPTFIEN,"M",DGMVTIEN,0)),U,2)=43 D
  1.  ..N DGPTNM,DGPTAD
  1.  ..;retrieve the patient's name and admission date
  1.  ..D GETS^DIQ(45,DGPTFIEN_",",".01;2","EI","DGPTINFO")
  1.  ..S DGPTNM=$E(DGPTINFO(45,DGPTFIEN_",",".01","E")_DGSPCS,1,30)
  1.  ..S DGPTAD=DGPTINFO(45,DGPTFIEN_",","2","E")
  1.  ..S DGTEXTLN=DGTEXTLN+1
  1.  ..;add a new line to the mail message in the format
  1.  ..;ptf record #, patient's name, admission date
  1.  ..S DGTEXT(DGTEXTLN)=$E(DGPTFIEN_DGSPCS,1,10)_" "_DGPTNM_" "_DGPTAD
  1.  ..K DGPTINFO,DGPTNM,DGPTAD
  1.  D GENMAIL(DGTEXTLN,.DGTEXT)
  1.  Q
  1. GENMAIL(DGTEXTLN,DGTEXT) ;Generate mail message with PTF information
  1.  N XMDUZ,XMSUB,XMY,XMTEXT,DIFROM ;Mailman Variables
  1.  S XMDUZ=".5" ;Message originates from postmaster
  1.  S XMY(DUZ)="" ;Send message to patch installer
  1.  S XMSUB="Treating Specialty Update DG*5.3*844"
  1.  S XMTEXT="DGTEXT("
  1.  S DGTEXT(1)="This message was generated by the installation of DG*5.3*844."
  1.  I DGTEXTLN=10 D  Q
  1.  .S DGTEXT(2)="There are no patients requiring treating specialty updates."
  1.  .S DGTEXT(3)="No action is required."
  1.  .D ^XMD
  1.  S DGTEXT(2)="There are patients at your site that are still assigned to treating specialty: "
  1.  S DGTEXT(3)="43 NH LONG STAY SKILLED NURING."
  1.  S DGTEXT(4)="This code is inactive as of October 1, 2011."
  1.  S DGTEXT(5)="Please forward this message to the appropriate MAS personnel for review."
  1.  S DGTEXT(6)=""
  1.  S DGTEXT(7)="Patients requiring treating specialty updates:"
  1.  S DGTEXT(8)=""
  1.  S DGTEXT(9)="PTF#       PATIENT                        ADMISSION DATE"
  1.  S DGTEXT(10)="------------------------------------------------------------------"
  1.  D ^XMD
  1.  Q