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

SD11STOP.m

Go to the documentation of this file. 
  1. SD11STOP ;ALB/RLC- Stop Code/DSS Identifier Update 6/18/07
  1.  ;;5.3;Scheduling;**570**;AUG 13, 1993;Build 3
  1.  ;
  1.  ;**  This patch is used as a Post-Init in a KIDS build to modify the
  1.  ;**  the CLINIC STOP file [^DIC(40.7,] for FY2011 updates.
  1.  ;
  1.  Q
  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(OLD+1),";;",2)'="QUIT" INACT
  1.  D:$P($T(CHNG+1),";;",2)'="QUIT" CHANGE
  1.  D:$P($T(CDR+1),";;",2)'="QUIT" CDRNUM
  1.  D:$P($T(ACT+1),";;",2)'="QUIT" REACT
  1.  D:$P($T(REST+1),";;",2)'="QUIT" RESTR
  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 10/1/2010]")
  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. INACT ;** Inactivate DSS IDs
  1.  ;
  1.  ;  SDXX is in format:
  1.  ; AMIS #^^INACTIVATION DATE (in FileMan format)
  1.  ;
  1.  N SDX,SDDA,SDXX,SDINDT,SDEXDT
  1.  S SDVAR=1
  1.  D MES^XPDUTL("")
  1.  D BMES^XPDUTL(">>> Inactivating Clinic Stops (DSS IDs) in CLINIC STOP File (#40.7)...")
  1.  D BMES^XPDUTL(" [NOTE:  These Stop Codes CANNOT be used AFTER the indicated inactivation date]")
  1.  F SDX=1:1 K DD,DO,DA S SDXX=$P($T(OLD+SDX),";;",2) Q:SDXX="QUIT"  DO
  1.  . I +$P(SDXX,"^",3) D
  1.  .. S X=$P(SDXX,"^",3)
  1.  .. ;
  1.  .. ;- Validate date passed in
  1.  .. S %DT="FTX"
  1.  .. D ^%DT
  1.  .. Q:Y<0
  1.  .. S SDINDT=Y
  1.  .. D DD^%DT
  1.  .. S SDEXDT=Y
  1.  .. S SDDA=0
  1.  .. F  S SDDA=$O(^DIC(40.7,"C",+SDXX,SDDA)) Q:'SDDA  D
  1.  ... I $D(^DIC(40.7,SDDA,0)) I $P(^(0),U,3)="" D
  1.  .... S DA=SDDA,DR="2////^S X=SDINDT",DIE="^DIC(40.7,"
  1.  .... D ^DIE,MESI(SDEXDT)
  1.  K %,%H,%I,DR,DA,DIC,DIE,DLAYGO,X,%DT,Y
  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=0
  1.  .F  S SDDA=$O(^DIC(40.7,"C",$P(SDXX,U,2),SDDA)) Q:'SDDA  D
  1.  ..I $D(^DIC(40.7,SDDA,0)) I $P(^(0),U,3)="" D
  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. CDRNUM ;** Change CDR numbers
  1.  ;
  1.  ;  SDXX is in format:
  1.  ; STOP CODE NAME (AMIS #) ^ AMIS # ^ OLD CDR # ^ NEW CDR #
  1.  ;
  1.  N SDX,SDXX,SDDA
  1.  S SDVAR=2
  1.  D MES^XPDUTL("")
  1.  D BMES^XPDUTL(">>> Changing CDR numbers in CLINIC STOP File (#40.7)...")
  1.  F SDX=1:1 K DD,DO,DA S SDXX=$P($T(CDR+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="4///"_$P(SDXX,U,4),DIE="^DIC(40.7,"
  1.  ..D ^DIE,MESN
  1.  K DIE,DR,DA,X
  1.  Q
  1.  ;
  1. REACT ;** Reactivate DSS IDs
  1.  ;
  1.  ;  SDXX is in format:
  1.  ; AMIS #^
  1.  ;
  1.  N SDX,SDDA,SDXX
  1.  S SDVAR=1
  1.  D MES^XPDUTL("")
  1.  D BMES^XPDUTL(">>> Reactivating Clinic Stops (DSS IDs) in CLINIC STOP File (#40.7)...")
  1.  ;Inactivation date is an uneditable field, cannot use DIE to delete so
  1.  ;must manually set piece to null if stop code being reactivated.
  1.  F SDX=1:1 K DD,DO,DA S SDXX=$P($T(ACT+SDX),";;",2) Q:SDXX="QUIT"  D
  1.  .S SDDA=+$O(^DIC(40.7,"C",+SDXX,0))
  1.  .I $P($G(^DIC(40.7,SDDA,0)),"^",3)'="" S $P(^DIC(40.7,SDDA,0),U,3)="" D MESA
  1.  Q
  1.  ;
  1. RESTR ;** Change Restriction Data
  1.  ;
  1.  ;  SDXX is in format:
  1.  ; STOP CODE NAME^STOP CODE NUMBER^RESTRICTION TYPE^RESTRICTION DATE
  1.  ;
  1.  N SDX,SDXX,SDDA
  1.  S SDVAR=3
  1.  D MES^XPDUTL("")
  1.  D BMES^XPDUTL(">>> Changing Restriction Data in CLINIC STOP File (#40.7)...")
  1.  F SDX=1:1 K DD,DO,DA S SDXX=$P($T(REST+SDX),";;",2) Q:SDXX="QUIT"  D
  1.  .S SDDA=0
  1.  .F  S SDDA=$O(^DIC(40.7,"C",$P(SDXX,U,2),SDDA)) Q:'SDDA  D
  1.  ..I $D(^DIC(40.7,SDDA,0)) I $P(^(0),U,3)="" D
  1.  ...S DA=SDDA,DR="5////"_$P(SDXX,U,3)_";6///@",DIE="^DIC(40.7,"
  1.  ...D ^DIE,MESR
  1.  K DIE,DR,DA,X
  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. MESI(SDEXDT) ;** Inactivate message
  1.  ;
  1.  ;  Parameter:
  1.  ;   SDEXDT - Date inactivation affective (External Format)
  1.  ;
  1.  N SDINMSG
  1.  I +$G(SDVAR) D HDR(SDVAR)
  1.  I $G(SDEXDT)="" S SDEXDT="UNKNOWN"
  1.  D MES^XPDUTL(" ")
  1.  S SDINMSG="Inactivated:  "_+SDXX_"           "_$P($G(^DIC(40.7,SDDA,0)),"^")_" as of "_SDEXDT
  1.  D MES^XPDUTL(SDINMSG)
  1.  K SDVAR
  1.  Q
  1.  ;
  1. MESA ;** Reactivate message
  1.  ;
  1.  N SDACMSG
  1.  I +$G(SDVAR) D HDR(SDVAR)
  1.  D MES^XPDUTL(" ")
  1.  S SDACMSG="Reactivated:  "_+SDXX_"           "_$P($G(^DIC(40.7,SDDA,0)),"^")
  1.  D MES^XPDUTL(SDACMSG)
  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. MESN ;** Change number
  1.  N SDNMSG,SDNMSG1
  1.  I +$G(SDVAR) D HDR(SDVAR)
  1.  D MES^XPDUTL(" ")
  1.  S SDNMSG="  Changed: "_$P(SDXX,U,2)_"    "_$P(SDXX,U)
  1.  S SDNMSG1="   : "_$P(SDXX,U,3)_" Date: "_$P(SDXX,U,5)
  1.  D MES^XPDUTL(SDNMSG)
  1.  D MES^XPDUTL(SDNMSG1)
  1.  K SDVAR
  1.  Q
  1. MESR ;** Restricting Stop Code
  1.  N SDNMSG,SDNMSG1
  1.  I +$G(SDVAR) D HDR(SDVAR)
  1.  D MES^XPDUTL(" ")
  1.  S SDNMSG="Changed:   "_$P(SDXX,U,2)_"            "_$P(SDXX,U)_"               "_$P(SDXX,U,5)_"         "_$P(SDXX,U,6)
  1.  S SDNMSG1="     to:                                                 "_$P(SDXX,U,3)_"         "_$P(SDXX,U,4)
  1.  D MES^XPDUTL(SDNMSG)
  1.  D MES^XPDUTL(SDNMSG1)
  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.  ;;PEDIATRICS^341^E
  1.  ;;FAMILY PRACTICE^342^E
  1.  ;;EPILEPSY ECOE^345^E
  1.  ;;EP LAB^369^E
  1.  ;;NC RTCV TELECARE PT LOC^644^S^10/1/2010
  1.  ;;NC RTCV TELECARE PRV LOC^645^S^10/1/2010
  1.  ;;NC S&F TELECARE PT LOC^646^S^10/1/2010
  1.  ;;NC S&F TELECARE PRV LOC^647^S^10/1/2010
  1.  ;;NC RTCV TELECARE NONVAMC^648^S^10/1/2010
  1.  ;;OTHER ED GRP^720^S^10/1/2010
  1.  ;;QUIT
  1.  ;
  1. OLD ;DSS IDs to be inactivated- ex. ;;AMIS NUMBER^^INACTIVE DATE
  1.  ;;294^OBSERVATION BLIND REHAB^10/1/2010
  1.  ;;640^SEND-OUT PROCS NOT FEE^10/1/2010
  1.  ;;712^HEP C REGISTRY PATIENT^10/1/2010
  1.  ;;QUIT
  1.  ;
  1. CHNG ;DSS ID name changes- example ;;STOP CODE NAME^NUMBER^^NEW NAME
  1.  ;;HOME TELEVIDEO CARE^179^^RT CLIN VID CARE HOME
  1.  ;;AMPUTATION FOLLOW-UP CLINIC^211^^PM&RS AMP CLINIC
  1.  ;;WOMEN'S CLINIC^322^^COMP WOMEN'S HLTH
  1.  ;;PROSTHETIC SUPPLY DISPENSED^423^^PROS AND SENS AIDS
  1.  ;;GENERAL TELEHEALTH REAL TIME^690^^RT CLIN VID TH PAT SITE
  1.  ;;GEN TELEHLTH RT SAME STA^692^^RT CLIN VD TH PRV SITE(SAMSTA)
  1.  ;;GEN TELEHLTH RT DIFF STA^693^^RT CLIN VD TH PRV SITE(DIFSTA)
  1.  ;;STORE & FORWARD TELEHLTH^694^^SF TH PAT SITE
  1.  ;;STORE & FWD TELEHLTH SAME STA^695^^SF TH PRV SITE(SAMSTA)
  1.  ;;STORE & FWD TELEHLTH DIFF STA^696^^SF TH PRV SITE(DIFSTA)
  1.  ;;BLOOD PRESSURE CHECK^701^^BP EVAL
  1.  ;;FEMALE SPEC CANCER SCREEN^704^^WOMENS GEN SPEC CA CARE
  1.  ;;OTHER EDUCATION 2ND ONLY^714^^OTHER ED IND
  1.  ;;QUIT
  1.  ;
  1. CDR ;CDR account change- ex. ;;STOP CODE NAME^NUMBER^CDR # (old)^CDR# (new)
  1.  ;;QUIT
  1.  ;
  1. ACT ;DSS IDs to be reactivated- example ;;NUMBER^
  1.  ;;QUIT
  1.  ;
  1. REST ;Change restriction - ;;STOP CODE NAME^NUMBER^REST TYPE^RES DATE^OLD
  1.  ;;VISOR & ADVANCED BLIND REHAB^220^E^^P
  1.  ;;VICTORS & ADVANCED LOW VISION^437^E^^P
  1.  ;;INTERMED LOW VISION CARE^438^E^^P
  1.  ;;QUIT