SD08SUPP	;ALB/RLC- Stop Code/DSS Identifier Update 6/18/07
	;;5.3;Scheduling;**531**;AUG 13, 1993;Build 1
	;
	;**  This patch is used as a Post-Init in a KIDS build to modify the
	;**  the CLINIC STOP file [^DIC(40.7,] for a FY08 supplemental update.
	;
EN	;** Add/inactivate/change/reactivate DSS IDs (stop codes)
	;**  The following code executes if file modifications exist
	;
	N SDVAR
	D:$P($T(NEW+1),";;",2)'="QUIT" ADD
	Q
	;
	;
ADD	;** Add DSS IDs
	;
	;  SDXX is in format:
	; STOP CODE NAME^AMIS #^RESTRICTION TYPE^REST. DATE^CDR #
	;
	N SDX,SDXX
	S SDVAR=1
	D MES^XPDUTL("")
	D BMES^XPDUTL(">>> Adding new Clinic Stop (DSS IDs) to CLINIC STOP File (#40.7)...")
	;
	;** NOTE: The following line is for DSS IDs that are not yet active
	D BMES^XPDUTL(" [NOTE: This Stop Code CANNOT be used UNTIL 02/15/2008]")
	S DIC(0)="L",DLAYGO=40.7,DIC="^DIC(40.7,"
	F SDX=1:1 K DD,DO,DA S SDXX=$P($T(NEW+SDX),";;",2) Q:SDXX="QUIT"  DO
	.S DIC("DR")="1////"_$P(SDXX,"^",2)_$S('+$P(SDXX,U,5):"",1:";4////"_$P(SDXX,"^",5))
	.S DIC("DR")=DIC("DR")_";5////"_$P(SDXX,"^",3)_";6///"_$P(SDXX,"^",4)
	.S X=$P(SDXX,"^",1)
	.I '$D(^DIC(40.7,"C",$P(SDXX,"^",2))) D FILE^DICN,MESS Q
	K DIC,DLAYGO,X
	Q
	;
RESTR	;** Change Restriction Data
	;
	;  SDXX is in format:
	; STOP CODE NAME^STOP CODE NUMBER^RESTRICTION TYPE^RESTRICTION DATE
	;
	N SDX,SDXX,SDDA
	S SDVAR=3
	D MES^XPDUTL("")
	D BMES^XPDUTL(">>> Changing Restriction Data in CLINIC STOP File (#40.7)...")
	F SDX=1:1 K DD,DO,DA S SDXX=$P($T(REST+SDX),";;",2) Q:SDXX="QUIT"  D
	.S SDDA=+$O(^DIC(40.7,"C",$P(SDXX,U,2),0))
	.I $D(^DIC(40.7,SDDA,0)) D
	..I $P(SDXX,U,2)=571 S DA=SDDA,DR="5////"_$P(SDXX,U,3)_";6///@",DIE="^DIC(40.7," D ^DIE,MESR Q
	..S DA=SDDA,DR="5////"_$P(SDXX,U,3)_";6///"_$P(SDXX,U,4),DIE="^DIC(40.7,"
	..D ^DIE,MESR
	K DIE,DR,DA,X
	Q
	;
MESS	;** Add message
	N ECXADMSG
	I +$G(SDVAR) D HDR(SDVAR)
	D MES^XPDUTL(" ")
	S ECXADMSG="Added:       "_$P(SDXX,"^",2)_"      "_$P(SDXX,"^")
	I $P(SDXX,"^",5)'="" S ECXADMSG=ECXADMSG_" [CDR#: "_$P(SDXX,"^",5)_"]"
	D MES^XPDUTL(ECXADMSG)
	I $P(SDXX,"^",3)'="" S ECXADMSG="                      Restricted Type: "_$P(SDXX,"^",3)_"    Restricted Date: "_$P(SDXX,"^",4)
	D MES^XPDUTL(ECXADMSG)
	K SDVAR
	Q
	;
MESR	;** Restricting Stop Code
	N SDNMSG,SDNMSG1
	I +$G(SDVAR) D HDR(SDVAR)
	D MES^XPDUTL(" ")
	S SDNMSG="Changed:   "_$P(SDXX,U,2)_"            "_$P(SDXX,U)_"               "_$P(SDXX,U,5)_"         "_$P(SDXX,U,6)
	S SDNMSG1="     to:                                                 "_$P(SDXX,U,3)_"         "_$P(SDXX,U,4)
	D MES^XPDUTL(SDNMSG)
	D MES^XPDUTL(SDNMSG1)
	K SDVAR
	Q
	;
HDR(SDVAR)	;- Header
	Q:'$G(SDVAR)
	N SDHDR
	S SDHDR=$P($T(@("HDR"_SDVAR)),";;",2)
	D BMES^XPDUTL(SDHDR)
	Q
	;
	;
HDR1	;;           Stop Code              Name
	;
HDR2	;;                CDR        Stop Code             Name
	;
HDR3	;;           Stop Code      Name                       Rest. Type    Date
	;
NEW	;DSS IDs to add- ex ;;STOP CODE NAME^NUMBER^RESTRICTION TYPE^RESTRICTION DATE^CDR
	;;DIABETIC RETINAL SCREENING^718^P^2/15/2008
	;;QUIT