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

SD5USTOP.m

Go to the documentation of this file.
  1. SD5USTOP ;ALB/CAW,GTS,ESD,JAM,GT - Stop Code/DSS Identifier Update 2/10/2005
  1. ;;5.3;Scheduling;**428**;AUG 13, 1993
  1. ;
  1. ;** This patch is used as a Post-Init in a KIDS build to modify the
  1. ;** the DSS Identifier file [^DIC(40.7,]
  1. ;
  1. EN ;** Add/inactivate/change/reactivate DSS IDs (stop codes)
  1. ;** The following code executes if file modifications exist
  1. ;
  1. N SDVAR
  1. D:$P($T(NEW+1),";;",2)'="QUIT" ADD
  1. D:$P($T(CHNG+1),";;",2)'="QUIT" CHANGE
  1. Q
  1. ;
  1. ;
  1. ADD ;** Add DSS IDs
  1. ;
  1. ; SDXX is in format:
  1. ; STOP CODE NAME^AMIS #^RESTRICTION TYPE^REST. DATE^CDR #
  1. ;
  1. N SDX,SDXX
  1. S SDVAR=1
  1. D MES^XPDUTL("")
  1. D BMES^XPDUTL(">>> Adding new Clinic Stops (DSS IDs) to CLINIC STOP File (#40.7)...")
  1. ;
  1. ;** NOTE: The following line is for DSS IDs that are not yet active
  1. D BMES^XPDUTL(" [NOTE: These Stop Codes CANNOT be used UNTIL 2/1/05]")
  1. S DIC(0)="L",DLAYGO=40.7,DIC="^DIC(40.7,"
  1. F SDX=1:1 K DD,DO,DA S SDXX=$P($T(NEW+SDX),";;",2) Q:SDXX="QUIT" DO
  1. .S DIC("DR")="1////"_$P(SDXX,"^",2)_$S('+$P(SDXX,U,5):"",1:";4////"_$P(SDXX,"^",5))
  1. .S DIC("DR")=DIC("DR")_";5////"_$P(SDXX,"^",3)_";6///"_$P(SDXX,"^",4)
  1. .S X=$P(SDXX,"^",1)
  1. .I '$D(^DIC(40.7,"C",$P(SDXX,"^",2))) D FILE^DICN,MESS Q
  1. .;I $D(^DIC(40.7,"C",$P(SDXX,"^",2))) D EDIT(SDXX),MESSEX
  1. K DIC,DLAYGO,X
  1. Q
  1. ;
  1. EDIT(SDXX) ;- Edit fields w/new values if stop code record already exists
  1. ;
  1. Q:$G(SDXX)=""
  1. N DA,DIE,DLAYGO,DR
  1. S DA=+$O(^DIC(40.7,"C",+$P(SDXX,"^",2),0))
  1. Q:'DA
  1. S DIE="^DIC(40.7,",DR=".01////"_$P(SDXX,"^")_";1////"_$P(SDXX,"^",2)_";2////@"_$S('+$P(SDXX,U,5):"",1:";4////"_$P(SDXX,"^",5))_";5////"_$P(SDXX,"^",3)_";6///"_$P(SDXX,"^",4)
  1. D ^DIE
  1. Q
  1. ;
  1. CHANGE ;** Change DSS ID names
  1. ;
  1. ; SDXX is in format:
  1. ; STOP CODE NAME^AMIS #^^NEW STOP CODE NAME
  1. ;
  1. N SDX,SDXX,SDDA
  1. S SDVAR=1
  1. D MES^XPDUTL("")
  1. D BMES^XPDUTL(">>> Changing Clinic Stop (DSS ID) names in CLINIC STOP File (#40.7)...")
  1. F SDX=1:1 K DD,DO,DA S SDXX=$P($T(CHNG+SDX),";;",2) Q:SDXX="QUIT" DO
  1. .S SDDA=+$O(^DIC(40.7,"C",$P(SDXX,U,2),0))
  1. .I $D(^DIC(40.7,SDDA,0)) DO
  1. ..S DA=SDDA,DR=".01///"_$P(SDXX,U,4),DIE="^DIC(40.7,"
  1. ..D ^DIE,MESC
  1. K DIE,DR,DA
  1. Q
  1. ;
  1. MESS ;** Add message
  1. N ECXADMSG
  1. I +$G(SDVAR) D HDR(SDVAR)
  1. D MES^XPDUTL(" ")
  1. S ECXADMSG="Added: "_$P(SDXX,"^",2)_" "_$P(SDXX,"^")
  1. I $P(SDXX,"^",5)'="" S ECXADMSG=ECXADMSG_" [CDR#: "_$P(SDXX,"^",5)_"]"
  1. D MES^XPDUTL(ECXADMSG)
  1. I $P(SDXX,"^",3)'="" S ECXADMSG=" Restricted Type: "_$P(SDXX,"^",3)_" Restricted Date: "_$P(SDXX,"^",4)
  1. D MES^XPDUTL(ECXADMSG)
  1. K SDVAR
  1. Q
  1. ;
  1. MESSEX ;** Display message if stop code already exists
  1. N ECXADMSG
  1. I +$G(SDVAR) D HDR(SDVAR)
  1. D MES^XPDUTL(" ")
  1. S ECXADMSG=" "_$P(SDXX,"^",2)_" "_$P(SDXX,"^")_" already exists."
  1. D MES^XPDUTL(ECXADMSG)
  1. K SDVAR
  1. Q
  1. ;
  1. MESC ;** Change message
  1. N SDCMSG,SDCMSG1
  1. I +$G(SDVAR) D HDR(SDVAR)
  1. D MES^XPDUTL(" ")
  1. S SDCMSG="Changed: "_$P(SDXX,U,2)_" "_$P(SDXX,U)
  1. S SDCMSG1=" to: "_$P(SDXX,U,2)_" "_$P(SDXX,U,4)
  1. D MES^XPDUTL(SDCMSG)
  1. D MES^XPDUTL(SDCMSG1)
  1. K SDVAR
  1. Q
  1. ;
  1. HDR(SDVAR) ;- Header
  1. Q:'$G(SDVAR)
  1. N SDHDR
  1. S SDHDR=$P($T(@("HDR"_SDVAR)),";;",2)
  1. D BMES^XPDUTL(SDHDR)
  1. Q
  1. ;
  1. ;
  1. HDR1 ;; Stop Code Name
  1. ;
  1. HDR2 ;; CDR Stop Code Name
  1. ;
  1. HDR3 ;; Stop Code Name Rest. Type Date
  1. ;
  1. NEW ;DSS IDs to add- ex ;;STOP CODE NAME^NUMBER^RESTRICTION TYPE^RESTRICTION DATE^CDR
  1. ;;QUIT
  1. ;
  1. CHNG ;DSS ID name changes- example ;;STOP CODE NAME^NUMBER^^NEW NAME
  1. ;;PMRS CWT/SE NON-F TO F (MASNONCT)^223^^PMRS CWT/SE NON-F TO F (MAS NO
  1. ;;PMRS CWT/TWE NON-F TO F (MASNONCT)^228^^PMRS CWT/TWE NON-F TO F (MAS N
  1. ;;VISOR (VISUAL IMPAIRMENT OUTPATIENT PROGRAM)^220^^VISOR (VISL IMPRMT OUTPAT PGM)
  1. ;;MH CWT/SE NON-F TO F (MAS NONCT^569^^MH CWT/SE NON-F TO F (MAS NONC
  1. ;;MH CWT/TWE NON-F TO F (MAS NONCT^570^^MH CWT/TWE NON-F TO F (MAS NON
  1. ;;NONVIDEO HOME TELEHEALTH INTERVENTION^684^^NONVIDEO HOME TELEHLTH INTRVNT
  1. ;;QUIT