source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SD08SUPP.m@ 1147

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