| 1 | SDYQSTOP ;ALB/CAW,GTS,ESD,JAM - Stop Code/DSS Identifier Update 8/19/03
|
---|
| 2 | ;;5.3;Scheduling;**311**;AUG 13, 1993
|
---|
| 3 | ;
|
---|
| 4 | ;** This patch is used as a Post-Init in a KIDS build to modify the
|
---|
| 5 | ;** the DSS Identifier file [^DIC(40.7,]
|
---|
| 6 | ;
|
---|
| 7 | EN ;** Add/inactivate/change/reactivate DSS IDs (stop codes)
|
---|
| 8 | ;** The following code executes if file modifications exist
|
---|
| 9 | ;
|
---|
| 10 | N SDVAR
|
---|
| 11 | D:$P($T(NEW+1),";;",2)'="QUIT" ADD
|
---|
| 12 | D:$P($T(OLD+1),";;",2)'="QUIT" INACT
|
---|
| 13 | D:$P($T(CHNG+1),";;",2)'="QUIT" CHANGE
|
---|
| 14 | D:$P($T(CDR+1),";;",2)'="QUIT" CDRNUM
|
---|
| 15 | D:$P($T(ACT+1),";;",2)'="QUIT" REACT
|
---|
| 16 | D:$P($T(REST+1),";;",2)'="QUIT" RESTR
|
---|
| 17 | Q
|
---|
| 18 | ;
|
---|
| 19 | ;
|
---|
| 20 | ADD ;** Add DSS IDs
|
---|
| 21 | ;
|
---|
| 22 | ; SDXX is in format:
|
---|
| 23 | ; STOP CODE NAME^AMIS #^RESTRICTION TYPE^REST. DATE^CDR #
|
---|
| 24 | ;
|
---|
| 25 | N SDX,SDXX
|
---|
| 26 | S SDVAR=1
|
---|
| 27 | D MES^XPDUTL("")
|
---|
| 28 | D BMES^XPDUTL(">>> Adding new Clinic Stops (DSS IDs) to CLINIC STOP File (#40.7)...")
|
---|
| 29 | ;
|
---|
| 30 | ;** NOTE: The following line is for DSS IDs that are not yet active
|
---|
| 31 | D BMES^XPDUTL(" [NOTE: These Stop Codes CANNOT be used UNTIL 4/1/03]")
|
---|
| 32 | S DIC(0)="L",DLAYGO=40.7,DIC="^DIC(40.7,"
|
---|
| 33 | F SDX=1:1 K DD,DO,DA S SDXX=$P($T(NEW+SDX),";;",2) Q:SDXX="QUIT" DO
|
---|
| 34 | .S DIC("DR")="1////"_$P(SDXX,"^",2)_$S('+$P(SDXX,U,5):"",1:";4////"_$P(SDXX,"^",5))
|
---|
| 35 | .S DIC("DR")=DIC("DR")_";5////"_$P(SDXX,"^",3)_";6///"_$P(SDXX,"^",4)
|
---|
| 36 | .S X=$P(SDXX,"^",1)
|
---|
| 37 | .I '$D(^DIC(40.7,"C",$P(SDXX,"^",2))) D FILE^DICN,MESS Q
|
---|
| 38 | .I $D(^DIC(40.7,"C",$P(SDXX,"^",2))) D EDIT(SDXX),MESSEX
|
---|
| 39 | K DIC,DLAYGO,X
|
---|
| 40 | Q
|
---|
| 41 | ;
|
---|
| 42 | EDIT(SDXX) ;- Edit fields w/new values if stop code record already exists
|
---|
| 43 | ;
|
---|
| 44 | Q:$G(SDXX)=""
|
---|
| 45 | N DA,DIE,DLAYGO,DR
|
---|
| 46 | S DA=+$O(^DIC(40.7,"C",+$P(SDXX,"^",2),0))
|
---|
| 47 | Q:'DA
|
---|
| 48 | 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)
|
---|
| 49 | D ^DIE
|
---|
| 50 | Q
|
---|
| 51 | INACT ;** Inactivate DSS IDs
|
---|
| 52 | ;
|
---|
| 53 | ; SDXX is in format:
|
---|
| 54 | ; AMIS #^^INACTIVATION DATE (in FileMan format)
|
---|
| 55 | ;
|
---|
| 56 | N SDX,SDDA,SDXX,SDINDT,SDEXDT
|
---|
| 57 | S SDVAR=1
|
---|
| 58 | D MES^XPDUTL("")
|
---|
| 59 | D BMES^XPDUTL(">>> Inactivating Clinic Stops (DSS IDs) in CLINIC STOP File (#40.7)...")
|
---|
| 60 | D BMES^XPDUTL(" [NOTE: These Stop Codes CANNOT be used AFTER the indicated inactivation date]")
|
---|
| 61 | F SDX=1:1 K DD,DO,DA S SDXX=$P($T(OLD+SDX),";;",2) Q:SDXX="QUIT" DO
|
---|
| 62 | . I +$P(SDXX,"^",3) D
|
---|
| 63 | .. S X=$P(SDXX,"^",3)
|
---|
| 64 | .. ;
|
---|
| 65 | .. ;- Validate date passed in
|
---|
| 66 | .. S %DT="FTX"
|
---|
| 67 | .. D ^%DT
|
---|
| 68 | .. Q:Y<0
|
---|
| 69 | .. S SDINDT=Y
|
---|
| 70 | .. D DD^%DT
|
---|
| 71 | .. S SDEXDT=Y
|
---|
| 72 | .. S SDDA=+$O(^DIC(40.7,"C",+SDXX,0))
|
---|
| 73 | .. I $D(^DIC(40.7,SDDA,0)) D
|
---|
| 74 | ... S DA=SDDA,DR="2////^S X=SDINDT",DIE="^DIC(40.7,"
|
---|
| 75 | ... D ^DIE,MESI(SDEXDT)
|
---|
| 76 | K %,%H,%I,DR,DA,DIC,DIE,DLAYGO,X,%DT,Y
|
---|
| 77 | Q
|
---|
| 78 | ;
|
---|
| 79 | CHANGE ;** Change DSS ID names
|
---|
| 80 | ;
|
---|
| 81 | ; SDXX is in format:
|
---|
| 82 | ; STOP CODE NAME^AMIS #^^NEW STOP CODE NAME
|
---|
| 83 | ;
|
---|
| 84 | N SDX,SDXX,SDDA
|
---|
| 85 | S SDVAR=1
|
---|
| 86 | D MES^XPDUTL("")
|
---|
| 87 | D BMES^XPDUTL(">>> Changing Clinic Stop (DSS ID) names in CLINIC STOP File (#40.7)...")
|
---|
| 88 | F SDX=1:1 K DD,DO,DA S SDXX=$P($T(CHNG+SDX),";;",2) Q:SDXX="QUIT" DO
|
---|
| 89 | .S SDDA=+$O(^DIC(40.7,"C",$P(SDXX,U,2),0))
|
---|
| 90 | .I $D(^DIC(40.7,SDDA,0)) DO
|
---|
| 91 | ..S DA=SDDA,DR=".01///"_$P(SDXX,U,4),DIE="^DIC(40.7,"
|
---|
| 92 | ..D ^DIE,MESC
|
---|
| 93 | K DIE,DR,DA
|
---|
| 94 | Q
|
---|
| 95 | ;
|
---|
| 96 | CDRNUM ;** Change CDR numbers
|
---|
| 97 | ;
|
---|
| 98 | ; SDXX is in format:
|
---|
| 99 | ; STOP CODE NAME (AMIS #) ^ AMIS # ^ OLD CDR # ^ NEW CDR #
|
---|
| 100 | ;
|
---|
| 101 | N SDX,SDXX,SDDA
|
---|
| 102 | S SDVAR=2
|
---|
| 103 | D MES^XPDUTL("")
|
---|
| 104 | D BMES^XPDUTL(">>> Changing CDR numbers in CLINIC STOP File (#40.7)...")
|
---|
| 105 | F SDX=1:1 K DD,DO,DA S SDXX=$P($T(CDR+SDX),";;",2) Q:SDXX="QUIT" DO
|
---|
| 106 | .S SDDA=+$O(^DIC(40.7,"C",$P(SDXX,U,2),0))
|
---|
| 107 | .I $D(^DIC(40.7,SDDA,0)) DO
|
---|
| 108 | ..S DA=SDDA,DR="4///"_$P(SDXX,U,4),DIE="^DIC(40.7,"
|
---|
| 109 | ..D ^DIE,MESN
|
---|
| 110 | K DIE,DR,DA,X
|
---|
| 111 | Q
|
---|
| 112 | ;
|
---|
| 113 | REACT ;** Reactivate DSS IDs
|
---|
| 114 | ;
|
---|
| 115 | ; SDXX is in format:
|
---|
| 116 | ; AMIS #^
|
---|
| 117 | ;
|
---|
| 118 | N SDX,SDDA,SDXX
|
---|
| 119 | S SDDA=+$O(^DIC(40.7,"C",510,0)) I $P($G(^DIC(40.7,SDDA,0)),"^",3)="" Q
|
---|
| 120 | S SDVAR=1
|
---|
| 121 | D MES^XPDUTL("")
|
---|
| 122 | D BMES^XPDUTL(">>> Reactivating Clinic Stops (DSS IDs) in CLINIC STOP File (#40.7)...")
|
---|
| 123 | F SDX=1:1 K DD,DO,DA S SDXX=$P($T(ACT+SDX),";;",2) Q:SDXX="QUIT" DO
|
---|
| 124 | .S SDDA=+$O(^DIC(40.7,"C",+SDXX,0))
|
---|
| 125 | .I $P($G(^DIC(40.7,SDDA,0)),"^",3)'="" DO
|
---|
| 126 | ..S DA=SDDA,DR="2///@",DIE="^DIC(40.7,"
|
---|
| 127 | ..D ^DIE,MESA
|
---|
| 128 | K DR,DA,DIE
|
---|
| 129 | Q
|
---|
| 130 | ;
|
---|
| 131 | RESTR ;** Change Restriction Data
|
---|
| 132 | ;
|
---|
| 133 | ; SDXX is in format:
|
---|
| 134 | ; STOP CODE NAME^STOP CODE NUMBER^RESTRICTION TYPE^RESTRICTION DATE
|
---|
| 135 | ;
|
---|
| 136 | N SDX,SDXX,SDDA
|
---|
| 137 | S SDVAR=3
|
---|
| 138 | D MES^XPDUTL("")
|
---|
| 139 | D BMES^XPDUTL(">>> Changing Restriction Data in CLINIC STOP File (#40.7)...")
|
---|
| 140 | F SDX=1:1 K DD,DO,DA S SDXX=$P($T(REST+SDX),";;",2) Q:SDXX="QUIT" D
|
---|
| 141 | .S SDDA=+$O(^DIC(40.7,"C",$P(SDXX,U,2),0))
|
---|
| 142 | .I $D(^DIC(40.7,SDDA,0)) D
|
---|
| 143 | ..S DA=SDDA,DR="5////"_$P(SDXX,U,3)_";6///"_$P(SDXX,U,4),DIE="^DIC(40.7,"
|
---|
| 144 | ..D ^DIE,MESR
|
---|
| 145 | K DIE,DR,DA,X
|
---|
| 146 | Q
|
---|
| 147 | ;
|
---|
| 148 | MESS ;** Add message
|
---|
| 149 | N ECXADMSG
|
---|
| 150 | I +$G(SDVAR) D HDR(SDVAR)
|
---|
| 151 | D MES^XPDUTL(" ")
|
---|
| 152 | S ECXADMSG="Added: "_$P(SDXX,"^",2)_" "_$P(SDXX,"^")
|
---|
| 153 | I $P(SDXX,"^",5)'="" S ECXADMSG=ECXADMSG_" [CDR#: "_$P(SDXX,"^",5)_"]"
|
---|
| 154 | D MES^XPDUTL(ECXADMSG)
|
---|
| 155 | I $P(SDXX,"^",3)'="" S ECXADMSG=" Restricted Type: "_$P(SDXX,"^",3)_" Restricted Date: "_$P(SDXX,"^",4)
|
---|
| 156 | D MES^XPDUTL(ECXADMSG)
|
---|
| 157 | K SDVAR
|
---|
| 158 | Q
|
---|
| 159 | ;
|
---|
| 160 | MESSEX ;** Display message if stop code already exists
|
---|
| 161 | N ECXADMSG
|
---|
| 162 | I +$G(SDVAR) D HDR(SDVAR)
|
---|
| 163 | D MES^XPDUTL(" ")
|
---|
| 164 | S ECXADMSG=" "_$P(SDXX,"^",2)_" "_$P(SDXX,"^")_" already exists."
|
---|
| 165 | D MES^XPDUTL(ECXADMSG)
|
---|
| 166 | K SDVAR
|
---|
| 167 | Q
|
---|
| 168 | ;
|
---|
| 169 | MESI(SDEXDT) ;** Inactivate message
|
---|
| 170 | ;
|
---|
| 171 | ; Parameter:
|
---|
| 172 | ; SDEXDT - Date inactivation affective (External Format)
|
---|
| 173 | ;
|
---|
| 174 | N SDINMSG
|
---|
| 175 | I +$G(SDVAR) D HDR(SDVAR)
|
---|
| 176 | I $G(SDEXDT)="" S SDEXDT="UNKNOWN"
|
---|
| 177 | D MES^XPDUTL(" ")
|
---|
| 178 | S SDINMSG="Inactivated: "_+SDXX_" "_$P($G(^DIC(40.7,SDDA,0)),"^")_" as of "_SDEXDT
|
---|
| 179 | D MES^XPDUTL(SDINMSG)
|
---|
| 180 | K SDVAR
|
---|
| 181 | Q
|
---|
| 182 | ;
|
---|
| 183 | MESA ;** Reactivate message
|
---|
| 184 | ;
|
---|
| 185 | N SDACMSG
|
---|
| 186 | I +$G(SDVAR) D HDR(SDVAR)
|
---|
| 187 | D MES^XPDUTL(" ")
|
---|
| 188 | S SDACMSG="Reactivated: "_+SDXX_" "_$P($G(^DIC(40.7,SDDA,0)),"^")
|
---|
| 189 | D MES^XPDUTL(SDACMSG)
|
---|
| 190 | K SDVAR
|
---|
| 191 | Q
|
---|
| 192 | ;
|
---|
| 193 | MESC ;** Change message
|
---|
| 194 | N SDCMSG,SDCMSG1
|
---|
| 195 | I +$G(SDVAR) D HDR(SDVAR)
|
---|
| 196 | D MES^XPDUTL(" ")
|
---|
| 197 | S SDCMSG="Changed: "_$P(SDXX,U,2)_" "_$P(SDXX,U)
|
---|
| 198 | S SDCMSG1=" to: "_$P(SDXX,U,2)_" "_$P(SDXX,U,4)
|
---|
| 199 | D MES^XPDUTL(SDCMSG)
|
---|
| 200 | D MES^XPDUTL(SDCMSG1)
|
---|
| 201 | K SDVAR
|
---|
| 202 | Q
|
---|
| 203 | ;
|
---|
| 204 | MESN ;** Change number
|
---|
| 205 | N SDNMSG,SDNMSG1
|
---|
| 206 | I +$G(SDVAR) D HDR(SDVAR)
|
---|
| 207 | D MES^XPDUTL(" ")
|
---|
| 208 | S SDNMSG=" Changed: "_$P(SDXX,U,2)_" "_$P(SDXX,U)
|
---|
| 209 | S SDNMSG1=" : "_$P(SDXX,U,3)_" Date: "_$P(SDXX,U,5)
|
---|
| 210 | D MES^XPDUTL(SDNMSG)
|
---|
| 211 | D MES^XPDUTL(SDNMSG1)
|
---|
| 212 | K SDVAR
|
---|
| 213 | Q
|
---|
| 214 | MESR ;** Restricting Stop Code
|
---|
| 215 | N SDNMSG,SDNMSG1
|
---|
| 216 | I +$G(SDVAR) D HDR(SDVAR)
|
---|
| 217 | D MES^XPDUTL(" ")
|
---|
| 218 | S SDNMSG="Changed: "_$P(SDXX,U,2)_" "_$P(SDXX,U)_" "_$P(SDXX,U,5)_" "_$P(SDXX,U,6)
|
---|
| 219 | S SDNMSG1=" to: "_$P(SDXX,U,3)_" "_$P(SDXX,U,4)
|
---|
| 220 | D MES^XPDUTL(SDNMSG)
|
---|
| 221 | D MES^XPDUTL(SDNMSG1)
|
---|
| 222 | K SDVAR
|
---|
| 223 | Q
|
---|
| 224 | ;
|
---|
| 225 | HDR(SDVAR) ;- Header
|
---|
| 226 | Q:'$G(SDVAR)
|
---|
| 227 | N SDHDR
|
---|
| 228 | S SDHDR=$P($T(@("HDR"_SDVAR)),";;",2)
|
---|
| 229 | D BMES^XPDUTL(SDHDR)
|
---|
| 230 | Q
|
---|
| 231 | ;
|
---|
| 232 | ;
|
---|
| 233 | HDR1 ;; Stop Code Name
|
---|
| 234 | ;
|
---|
| 235 | HDR2 ;; CDR Stop Code Name
|
---|
| 236 | ;
|
---|
| 237 | HDR3 ;; Stop Code Name Rest. Type Date
|
---|
| 238 | ;
|
---|
| 239 | NEW ;DSS IDs to add- ex ;;STOP CODE NAME^NUMBER^RESTRICTION TYPE^RESTRICTION DATE^CDR
|
---|
| 240 | ;;PHYSICIAN RESIDENT 2ND ONLY^188^S^10/1/2003
|
---|
| 241 | ;;TELEPHONE VIST PRI ONLY^221^P^10/1/2003
|
---|
| 242 | ;;PRIMARY CARE GROUP PRI ONLY^348^P^10/1/2003
|
---|
| 243 | ;;CCS EVALUATION^371^E^
|
---|
| 244 | ;;MED SPECIALTY GROUP PRI ONLY^394^P^10/1/2003
|
---|
| 245 | ;;ADMIN PT ORIENT NONCTMAS PRI^674^P^10/1/2003
|
---|
| 246 | ;;CCS OFFICE VISIT^685^E^
|
---|
| 247 | ;;CCS TELEPHONE CARE PRI^686^P^10/1/2003
|
---|
| 248 | ;;PPD CLINIC (2ND ONLY)^717^S^10/1/2003
|
---|
| 249 | ;;QUIT
|
---|
| 250 | ;
|
---|
| 251 | OLD ;DSS IDs to be inactivated- ex. ;;AMIS NUMBER^^INACTIVE DATE
|
---|
| 252 | ;;520^LONG TERM ENHANCEMENT INDIV^10/1/2003
|
---|
| 253 | ;;521^LONG TERM ENHANCEMENT GROUP^10/1/2003
|
---|
| 254 | ;;QUIT
|
---|
| 255 | ;
|
---|
| 256 | CHNG ;DSS ID name changes- example ;;STOP CODE NAME^NUMBER^^NEW NAME
|
---|
| 257 | ;;COUMADIN CLINIC^317^^ANTI-COAGULATION CLINIC
|
---|
| 258 | ;;TB PPD SHOT^473^^LOCAL USE (2NDARY ONLY)
|
---|
| 259 | ;;PSYCHIATRY CONSULTATION^512^^MENTAL HEALTH CONSULTATION
|
---|
| 260 | ;;TELEPHONE/GENERAL PSYCHIATRY^527^^MENTAL HEALTH TELEPHONE PRI
|
---|
| 261 | ;;QUIT
|
---|
| 262 | ;
|
---|
| 263 | CDR ;CDR account change- ex. ;;STOP CODE NAME^NUMBER^CDR # (old)^CDR# (new)
|
---|
| 264 | ;;QUIT
|
---|
| 265 | ;
|
---|
| 266 | ACT ;DSS IDs to be reactivated- example ;;NUMBER^
|
---|
| 267 | ;;QUIT
|
---|
| 268 | REST ;Change restriction - ;;STOP CODE NAME^NUMBER^REST TYPE^RES DATE^OLD
|
---|
| 269 | ;;VIST COORDINATOR^209^P^10/1/2003^E^
|
---|
| 270 | ;;QUIT
|
---|