SDYMPOST ;ALB/CAW - Scheduling Maintenance Update 5/26/94
;;5.3;Scheduling;**20**;Aug 13, 1993
;
EN ; -- add/inactivate stop codes
D ADD
D INACT
D CHANGE
D CDRNUM
; -- add OPC FY95 FORMAT DATE
S $P(^DG(43,1,"SCLR"),U,25)=2941001
Q
;
;
ADD W !!,">>> Adding new clinic stops to CLINIC STOP FILE (#40.7)..."
W !," [NOTE: These stop codes CANNOT be used UNTIL 10/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 9/30/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////2941001",DIE="^DIC(40.7," D ^DIE,MESI
K %,%H,%I,DGX,DGDA,DGXX,DR,DA,DIC,DIE,DLAYGO,SDATE,X
Q
;
CHANGE W !!,">>> Changing clinic stop names in CLINIC STOP CODE FILE (#40.7)..."
F DGX=1:1 K DD,DO,DA S DGXX=$P($T(CHNG+DGX),";;",2) Q:DGXX="QUIT" S DGDA=+$O(^DIC(40.7,"C",$P(DGXX,U,2),0)) I $D(^DIC(40.7,DGDA,0)) S DA=DGDA,DR=".01///"_$P(DGXX,U,4),DIE="^DIC(40.7," D ^DIE,MESC
K DGX,DGXX,DGDA,DIE,DR,DA Q
;
CDRNUM W !!,">>> Changing CDR numbers in CLINIC STOP CODE FILE (#40.7)..."
F DGX=1:1 K DD,DO,DA S DGXX=$P($T(CDR+DGX),";;",2) Q:DGXX="QUIT" S DGDA=+$O(^DIC(40.7,"C",$P(DGXX,U,2),0)) I $D(^DIC(40.7,DGDA,0)) S DA=DGDA,DR="4///"_$P(DGXX,U,4),DIE="^DIC(40.7," D ^DIE,MESN
K DGX,DGXX,DGDA,DIE,DR,DA 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 10/1/94..."
Q
;
MESC W !?8,"...",$P(DGXX,U)_$P(DGXX,U,3),?44,"changed to ",!?11,$P(DGXX,U,4),"..."
Q
;
MESN W !?8,"...",$P(DGXX,U)_" CDR ACCOUNT NUMBER: "_$P(DGXX,U,3),!,?11,"changed to "_$P(DGXX,U,4),"..."
Q
;
NEW ;stop codes to add - example ;;STOP CODE NAME^NUMBER^^^CDR
;;CHAPLAIN SERVICE - INDIVIDUAL^166^^^2610.00
;;CHAPLAIN SERVICE - GROUP^167^^^2610.00
;;CHAPLAIN SERVICE - COLLATERAL^168^^^2610.00
;;TELEPHONE/CHAPLAIN^169^^^2610.00
;;HBHC - RN/RNP/PA^171^^^5110.00
;;HBHC - NURSE EXTENDER^172^^^5110.00
;;HBHC - SOCIAL WORKER^173^^^5110.00
;;HBHC - THERAPIST^174^^^5110.00
;;HBHC - DIETITIAN^175^^^5110.00
;;HBHC - CLINICAL PHARMACIST^176^^^5110.00
;;HBHC - OTHER^177^^^5110.00
;;HBHC/TELEPHONE^178^^^5110.00
;;TELEPHONE/NEUROLOGY^325^^^2110.00
;;TELEPHONE/GERIATRICS^326^^^2110.00
;;WOMEN SURGERY^426^^^2210.00
;;PRIMARY CARE/SURGERY^427^^^2230.00
;;TELE/HOMELESS MENTALLY ILL^528^^^2311.00
;;HCHV/HMI^529^^^2311.00
;;TELEPHONE/HUD-VASH^530^^^2316.00
;;PRIMARY CARE/GENERAL PSY^531^^^2331.00
;;TELEPHONE/IPCC^546^^^5117.00
;;PRIMARY CARE/SPEC. PSY.^563^^^2330.00
;;DOM ADM SCREENING SERVICES^728^^^5115.00
;;TELEPHONE/DOMICILIARY^729^^^5115.00
;;QUIT
;
;
OLD ;STOP CODES TO BE INACTIVATED - example ;;NUMBER
;;501
;;543
;;544
;;545
;;QUIT
;
CHNG ;NAME CHANGES TO STOP CODES-example ;;STOP CODE NAME^NUMBER^ (NUMBER)^NEW NAME
;;HBHC^170^ (170)^HBHC - PHYSICIAN
;;REHABILITATION MEDICINE^201^ (201)^PHYSICAL MED & REHAB SVC
;;RMS INCENTIVE THERAPY^207^ (207)^PM&RS INCENTIVE THERAPY
;;RMS COMPENSATED WORK THERAPY^208^ (208)^PM&RS COMPENSATED WORK THERAPY
;;RMS VOCATIONAL ASSISTANCE^213^ (213)^PM&RS VOCATIONAL ASSISTANCE
;;GENERAL MEDICINE^301^ (301)^GENERAL INTERNAL MEDICINE
;;PRIMARY CARE^323^ (323)^PRIMARY CARE/MEDICINE
;;AMBULATORY SURGERY^416^ (416)^AMBULATORY SURGERY OFFICE
;;MENTAL HYGIENE-INDIVIDUAL^502^ (502)^MENTAL HEALTH - INDIVIDUAL
;;COMMUNITY CLINIC-INDIVIDUAL^504^ (504)^IPCC MEDICAL CENTER VISIT
;;MENTAL HYGIENE-GROUP^550^ (550)^MENTAL HEALTH CLINIC-GROUP
;;COMMUNITY CLINIC-GROUP^551^ (551)^IPCC COMM CLN/DAY PROGRAM VST
;;COMMUNITY DAY PROGRAM^552^ (552)^IPCC COMMUNITY VISIT
;;QUIT
;
CDR ;CDR ACCOUNT CHANGE-EXAMPLE ;;STOP CODE NAME (NUMBER)^NUMBER^CDR #^CDR#
;;PRIMARY CARE/MEDICINE (323)^323^2110.00^2130.00
;;IPCC MEDICAL CENTER VISIT (504)^504^5114.00^5117.00
;;IPCC COMM CLN/DAY PROGRAM VST (551)^551^5114.00^5117.00
;;IPCC COMMUNITY VISIT (552)^552^5114.00^5117.00
;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDYMPOST 4424 printed Apr 09, 2024@21:53:26 Page 2
SDYMPOST ;ALB/CAW - Scheduling Maintenance Update 5/26/94
+1 ;;5.3;Scheduling;**20**;Aug 13, 1993
+2 ;
EN ; -- add/inactivate stop codes
+1 DO ADD
+2 DO INACT
+3 DO CHANGE
+4 DO CDRNUM
+5 ; -- add OPC FY95 FORMAT DATE
+6 SET $PIECE(^DG(43,1,"SCLR"),U,25)=2941001
+7 QUIT
+8 ;
+9 ;
ADD WRITE !!,">>> Adding new clinic stops to CLINIC STOP FILE (#40.7)..."
+1 WRITE !," [NOTE: These stop codes CANNOT be used UNTIL 10/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 ;
INACT WRITE !!,">>> Inactivating clinic stops in CLINIC STOP CODE FILE (#40.7)..."
+1 WRITE !," [NOTE: These stop codes CANNOT be used AFTER 9/30/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////2941001"
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 ;
CHANGE WRITE !!,">>> Changing clinic stop names in CLINIC STOP CODE FILE (#40.7)..."
+1 FOR DGX=1:1
KILL DD,DO,DA
SET DGXX=$PIECE($TEXT(CHNG+DGX),";;",2)
if DGXX="QUIT"
QUIT
SET DGDA=+$ORDER(^DIC(40.7,"C",$PIECE(DGXX,U,2),0))
IF $DATA(^DIC(40.7,DGDA,0))
SET DA=DGDA
SET DR=".01///"_$PIECE(DGXX,U,4)
SET DIE="^DIC(40.7,"
DO ^DIE
DO MESC
+2 KILL DGX,DGXX,DGDA,DIE,DR,DA
QUIT
+3 ;
CDRNUM WRITE !!,">>> Changing CDR numbers in CLINIC STOP CODE FILE (#40.7)..."
+1 FOR DGX=1:1
KILL DD,DO,DA
SET DGXX=$PIECE($TEXT(CDR+DGX),";;",2)
if DGXX="QUIT"
QUIT
SET DGDA=+$ORDER(^DIC(40.7,"C",$PIECE(DGXX,U,2),0))
IF $DATA(^DIC(40.7,DGDA,0))
SET DA=DGDA
SET DR="4///"_$PIECE(DGXX,U,4)
SET DIE="^DIC(40.7,"
DO ^DIE
DO MESN
+2 KILL DGX,DGXX,DGDA,DIE,DR,DA
QUIT
+3 ;
MESS WRITE !?8,"...",X,?40,"(",$PIECE(DGXX,"^",2),") added..."
+1 QUIT
+2 ;
MESI WRITE !?8,"...",$PIECE(^DIC(40.7,DGDA,0),"^"),?40,"(",DGXX,") inactivated as of 10/1/94..."
+1 QUIT
+2 ;
MESC WRITE !?8,"...",$PIECE(DGXX,U)_$PIECE(DGXX,U,3),?44,"changed to ",!?11,$PIECE(DGXX,U,4),"..."
+1 QUIT
+2 ;
MESN WRITE !?8,"...",$PIECE(DGXX,U)_" CDR ACCOUNT NUMBER: "_$PIECE(DGXX,U,3),!,?11,"changed to "_$PIECE(DGXX,U,4),"..."
+1 QUIT
+2 ;
NEW ;stop codes to add - example ;;STOP CODE NAME^NUMBER^^^CDR
+1 ;;CHAPLAIN SERVICE - INDIVIDUAL^166^^^2610.00
+2 ;;CHAPLAIN SERVICE - GROUP^167^^^2610.00
+3 ;;CHAPLAIN SERVICE - COLLATERAL^168^^^2610.00
+4 ;;TELEPHONE/CHAPLAIN^169^^^2610.00
+5 ;;HBHC - RN/RNP/PA^171^^^5110.00
+6 ;;HBHC - NURSE EXTENDER^172^^^5110.00
+7 ;;HBHC - SOCIAL WORKER^173^^^5110.00
+8 ;;HBHC - THERAPIST^174^^^5110.00
+9 ;;HBHC - DIETITIAN^175^^^5110.00
+10 ;;HBHC - CLINICAL PHARMACIST^176^^^5110.00
+11 ;;HBHC - OTHER^177^^^5110.00
+12 ;;HBHC/TELEPHONE^178^^^5110.00
+13 ;;TELEPHONE/NEUROLOGY^325^^^2110.00
+14 ;;TELEPHONE/GERIATRICS^326^^^2110.00
+15 ;;WOMEN SURGERY^426^^^2210.00
+16 ;;PRIMARY CARE/SURGERY^427^^^2230.00
+17 ;;TELE/HOMELESS MENTALLY ILL^528^^^2311.00
+18 ;;HCHV/HMI^529^^^2311.00
+19 ;;TELEPHONE/HUD-VASH^530^^^2316.00
+20 ;;PRIMARY CARE/GENERAL PSY^531^^^2331.00
+21 ;;TELEPHONE/IPCC^546^^^5117.00
+22 ;;PRIMARY CARE/SPEC. PSY.^563^^^2330.00
+23 ;;DOM ADM SCREENING SERVICES^728^^^5115.00
+24 ;;TELEPHONE/DOMICILIARY^729^^^5115.00
+25 ;;QUIT
+26 ;
+27 ;
OLD ;STOP CODES TO BE INACTIVATED - example ;;NUMBER
+1 ;;501
+2 ;;543
+3 ;;544
+4 ;;545
+5 ;;QUIT
+6 ;
CHNG ;NAME CHANGES TO STOP CODES-example ;;STOP CODE NAME^NUMBER^ (NUMBER)^NEW NAME
+1 ;;HBHC^170^ (170)^HBHC - PHYSICIAN
+2 ;;REHABILITATION MEDICINE^201^ (201)^PHYSICAL MED & REHAB SVC
+3 ;;RMS INCENTIVE THERAPY^207^ (207)^PM&RS INCENTIVE THERAPY
+4 ;;RMS COMPENSATED WORK THERAPY^208^ (208)^PM&RS COMPENSATED WORK THERAPY
+5 ;;RMS VOCATIONAL ASSISTANCE^213^ (213)^PM&RS VOCATIONAL ASSISTANCE
+6 ;;GENERAL MEDICINE^301^ (301)^GENERAL INTERNAL MEDICINE
+7 ;;PRIMARY CARE^323^ (323)^PRIMARY CARE/MEDICINE
+8 ;;AMBULATORY SURGERY^416^ (416)^AMBULATORY SURGERY OFFICE
+9 ;;MENTAL HYGIENE-INDIVIDUAL^502^ (502)^MENTAL HEALTH - INDIVIDUAL
+10 ;;COMMUNITY CLINIC-INDIVIDUAL^504^ (504)^IPCC MEDICAL CENTER VISIT
+11 ;;MENTAL HYGIENE-GROUP^550^ (550)^MENTAL HEALTH CLINIC-GROUP
+12 ;;COMMUNITY CLINIC-GROUP^551^ (551)^IPCC COMM CLN/DAY PROGRAM VST
+13 ;;COMMUNITY DAY PROGRAM^552^ (552)^IPCC COMMUNITY VISIT
+14 ;;QUIT
+15 ;
CDR ;CDR ACCOUNT CHANGE-EXAMPLE ;;STOP CODE NAME (NUMBER)^NUMBER^CDR #^CDR#
+1 ;;PRIMARY CARE/MEDICINE (323)^323^2110.00^2130.00
+2 ;;IPCC MEDICAL CENTER VISIT (504)^504^5114.00^5117.00
+3 ;;IPCC COMM CLN/DAY PROGRAM VST (551)^551^5114.00^5117.00
+4 ;;IPCC COMMUNITY VISIT (552)^552^5114.00^5117.00
+5 ;;QUIT
