SDYBSTOP ;ALB/MLI - Add new Clinic Stop Codes ; 12/10/93
;;5.3;Scheduling;**13**;Aug 13, 1993
;
EN ; -- add/inactivate stop codes
D ADD
D INACT
Q
;
;
ADD W !!,">>> Adding new clinic stops to CLINIC STOP FILE (#40.7)..."
W !," [NOTE: These stop codes CANNOT be used UNTIL 2/1/94]",!
S DIC(0)="L",DLAYGO=40.7,DIC="^DIC(40.7,"
F DGX=1:1 K DD,DO,DA S DGXX=$P($T(NEW+DGX),";;",2) Q:DGXX="QUIT" D
. S DIC("DR")="1////"_$P(DGXX,"^",2)_$S('+$P(DGXX,U,5):"",1:";4////"_$P(DGXX,"^",5)),X=$P(DGXX,"^",1)
. I '$D(^DIC(40.7,"C",$P(DGXX,"^",2))) D FILE^DICN,MESS
K DIC,DGXX
Q
;
;
INACT W !!,">>> Inactivating clinic stops in CLINIC STOP CODE FILE (#40.7)..."
W !," [NOTE: These stop codes CANNOT be used AFTER 1/31/94]",!
D NOW^%DTC S SDATE=X
F DGX=1:1 K DD,DO,DA S DGXX=$P($T(OLD+DGX),";;",2) Q:DGXX="QUIT" D
. S DGDA=+$O(^DIC(40.7,"C",DGXX,0))
. I $D(^DIC(40.7,DGDA,0)) S DA=DGDA,DR="2////2940131",DIE="^DIC(40.7," D ^DIE,MESI
K %,%H,%I,DGX,DGDA,DGXX,DR,DA,DIC,DIE,DLAYGO,SDATE,X
Q
;
;
MESS W !?8,"...",X,?40,"(",$P(DGXX,"^",2),") added..."
Q
;
;
MESI W !?8,"...",$P(^DIC(40.7,DGDA,0),"^"),?40,"(",DGXX,") inactivated as of 1/31/94..."
Q
;
;
NEW ;stop codes to add
;;TELEPHONE TRIAGE^103^^^2111.00
;;PRIMARY CARE^323^^^2110.00
;;TELEPHONE/MEDICINE^324^^^2110.00
;;TELEPHONE/SURGERY^424^^^2210.00
;;TELEPHONE/SPECIAL PSYCHIATRY^526^^^2310.00
;;TELEPHONE/GENERAL PSYCHIATRY^527^^^2311.00
;;TELEPHONE/PTSD^542^^^2313.00
;;TELEPHONE/ALCOHOL DEPENDENCE^543^^^2316.00
;;TELEPHONE/DRUG DEPENDENCE^544^^^2316.00
;;TELEPHONE/SUBSTANCE ABUSE^545^^^2316.00
;;TELEPHONE/ANCILLARY^147^^^2610.00
;;TELEPHONE/REHAB AND SUPPORT^216^^^2611.00
;;TELEPHONE/DIAGNOSTIC^148^^^2612.00
;;TELEPHONE/PROSTHETICS/ORTHOTIC^425^^^2614.00
;;TELEPHONE/DENTAL^181^^^2710.00
;;TELEPHONE/DIALYSIS^611^^^2410.00
;;WOMEN'S STRESS DISORDER TEAMS^525^^^2311.00
;;QUIT
;
;
OLD ;STOP CODES TO BE INACTIVATED
;;571
;;572
;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDYBSTOP 2002 printed Apr 09, 2024@21:56:19 Page 2
SDYBSTOP ;ALB/MLI - Add new Clinic Stop Codes ; 12/10/93
+1 ;;5.3;Scheduling;**13**;Aug 13, 1993
+2 ;
EN ; -- add/inactivate stop codes
+1 DO ADD
+2 DO INACT
+3 QUIT
+4 ;
+5 ;
ADD WRITE !!,">>> Adding new clinic stops to CLINIC STOP FILE (#40.7)..."
+1 WRITE !," [NOTE: These stop codes CANNOT be used UNTIL 2/1/94]",!
+2 SET DIC(0)="L"
SET DLAYGO=40.7
SET DIC="^DIC(40.7,"
+3 FOR DGX=1:1
KILL DD,DO,DA
SET DGXX=$PIECE($TEXT(NEW+DGX),";;",2)
if DGXX="QUIT"
QUIT
Begin DoDot:1
+4 SET DIC("DR")="1////"_$PIECE(DGXX,"^",2)_$SELECT('+$PIECE(DGXX,U,5):"",1:";4////"_$PIECE(DGXX,"^",5))
SET X=$PIECE(DGXX,"^",1)
+5 IF '$DATA(^DIC(40.7,"C",$PIECE(DGXX,"^",2)))
DO FILE^DICN
DO MESS
End DoDot:1
+6 KILL DIC,DGXX
+7 QUIT
+8 ;
+9 ;
INACT WRITE !!,">>> Inactivating clinic stops in CLINIC STOP CODE FILE (#40.7)..."
+1 WRITE !," [NOTE: These stop codes CANNOT be used AFTER 1/31/94]",!
+2 DO NOW^%DTC
SET SDATE=X
+3 FOR DGX=1:1
KILL DD,DO,DA
SET DGXX=$PIECE($TEXT(OLD+DGX),";;",2)
if DGXX="QUIT"
QUIT
Begin DoDot:1
+4 SET DGDA=+$ORDER(^DIC(40.7,"C",DGXX,0))
+5 IF $DATA(^DIC(40.7,DGDA,0))
SET DA=DGDA
SET DR="2////2940131"
SET DIE="^DIC(40.7,"
DO ^DIE
DO MESI
End DoDot:1
+6 KILL %,%H,%I,DGX,DGDA,DGXX,DR,DA,DIC,DIE,DLAYGO,SDATE,X
+7 QUIT
+8 ;
+9 ;
MESS WRITE !?8,"...",X,?40,"(",$PIECE(DGXX,"^",2),") added..."
+1 QUIT
+2 ;
+3 ;
MESI WRITE !?8,"...",$PIECE(^DIC(40.7,DGDA,0),"^"),?40,"(",DGXX,") inactivated as of 1/31/94..."
+1 QUIT
+2 ;
+3 ;
NEW ;stop codes to add
+1 ;;TELEPHONE TRIAGE^103^^^2111.00
+2 ;;PRIMARY CARE^323^^^2110.00
+3 ;;TELEPHONE/MEDICINE^324^^^2110.00
+4 ;;TELEPHONE/SURGERY^424^^^2210.00
+5 ;;TELEPHONE/SPECIAL PSYCHIATRY^526^^^2310.00
+6 ;;TELEPHONE/GENERAL PSYCHIATRY^527^^^2311.00
+7 ;;TELEPHONE/PTSD^542^^^2313.00
+8 ;;TELEPHONE/ALCOHOL DEPENDENCE^543^^^2316.00
+9 ;;TELEPHONE/DRUG DEPENDENCE^544^^^2316.00
+10 ;;TELEPHONE/SUBSTANCE ABUSE^545^^^2316.00
+11 ;;TELEPHONE/ANCILLARY^147^^^2610.00
+12 ;;TELEPHONE/REHAB AND SUPPORT^216^^^2611.00
+13 ;;TELEPHONE/DIAGNOSTIC^148^^^2612.00
+14 ;;TELEPHONE/PROSTHETICS/ORTHOTIC^425^^^2614.00
+15 ;;TELEPHONE/DENTAL^181^^^2710.00
+16 ;;TELEPHONE/DIALYSIS^611^^^2410.00
+17 ;;WOMEN'S STRESS DISORDER TEAMS^525^^^2311.00
+18 ;;QUIT
+19 ;
+20 ;
OLD ;STOP CODES TO BE INACTIVATED
+1 ;;571
+2 ;;572
+3 ;;QUIT
