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

SDVPT.m

Go to the documentation of this file. 
  1. SDVPT ;alb/mjk - SD Post-Init Driver ; 3/26/93
  1.  ;;5.3;Scheduling;**5,1015**;Aug 13, 1993;Build 21
  1.  ;
  1. EN ; -- main entry point
  1.  S XQABT4=$H
  1.  I '$D(DGVREL) D VERS^DGVPP G ENQ:'$D(DGVREL)
  1.  S DGVFLD=110 D TIME^DGVPR
  1.  ;
  1.  D LINE^DGVPP,EVTS                   ; protocols
  1.  D LINE^DGVPP,LIST                   ; list templates
  1.  D LINE^DGVPP,COMP                   ; list compiled templates
  1.  D LINE^DGVPP,SC                     ; add/inactivate stop codes
  1.  D EN^SDV53PT                        ; current version tasks
  1.  D LINE^DGVPP,TASKS                  ; restore queued times
  1.  S DGPACK="SD" D LINE^DGVPP,^DGVPT1  ; delete options
  1.  D LINE^DGVPP
  1.  ;
  1.  D TIME^SDUTL S DGTIME=SDTIME,DGVFLD=111 D TIME1^DGVPR
  1.  S $P(^DG(43,1,"SCLR"),U,5)=DGVNEW
  1.  S XQABT5=$H
  1.  S X="SDINITY" X ^%ZOSF("TEST") I $T D ^SDINITY
  1.  W !!,*7,">>> Initialization of Version ",DGVNEWVR," of SD Complete."
  1. ENQ G Q^SDVPP
  1.  ;
  1. EVTS ;Move SD Options to Protocol File
  1.  S X="" D ^SDONIT
  1.  Q
  1.  ;
  1. TASKS ; -- requeue tasked jobs
  1.  I $O(DGTJ(0))'="" W !!,">>> Restoring queued jobs to original state...",! S DGEDIT=1 D RES^DGVPR1 K DGTJ
  1.  K DA,DGI,DIC,DIE,DR,X,Y,DGEDIT
  1.  Q
  1.  ;
  1. COMP ; -- list templates to re-compile
  1.  W !!,">>> Remember to recompile the following templates on all CPU's..."
  1.  W !!?4,"Template",?30,"Routine",?45,"Type",?55,"Routine Used to Recompile",!?4,"--------",?30,"-------",?45,"----",?55,"-------------------------"
  1.  F I=1:1 S J=$P($T(TEMP+I),";;",2) Q:J="QUIT"  W !?4,$P(J,";",1),?30,$P(J,";",2),?45,$S($P(J,";",3)="I":"INPUT",1:"PRINT"),?64,$S($P(J,";",3)="I":"DIEZ",1:"DIPZ")
  1.  W !!,"NOTE:  To recompile all PIMS compiled templates and compiled ",!?7,"cross-references you can call ALL^DGUTL1."
  1.  Q
  1.  ;
  1. TEMP ;
  1.  ;;SDB;SDBT;I
  1.  ;;SDM1;SDM1T;I
  1.  ;;SDAMBT;SDXA;I
  1.  ;;SDXACSE;SDXACSE;I
  1.  ;;SD ENCOUNTER ENTRY;SDAMXOE;I
  1.  ;;SD-AMB-PROC-DISPLAY;SDXAMB;P
  1.  ;;SD-AMB-PROC-LIST;SDXLST;P
  1.  ;;SD-AMB-RAM-DISPLAY;SDXRAM;P
  1.  ;;SDAMVLD;SDAMXLD;P
  1.  ;;SDUL LIST TEMPLATE;SDULXP;P
  1.  ;;QUIT
  1.  ;
  1. LIST ; -- add list templates
  1.  W !!,">>> List Template installation..."
  1.  D ^SDVLT
  1.  Q
  1.  ;
  1. SC ; -- add/inactivate stop codes
  1.  W !!,">>> Adding new clinic stops to CLINIC STOP FILE (#40.7)..."
  1.  W !,"    [NOTE:  These stop codes CANNOT be used UNTIL 10/1/93]",!
  1.  S DIC(0)="L",DIC="^DIC(40.7,"
  1.  F DGX=1:1 K DD,DO,DA S DGXX=$P($T(SCS+DGX),";;",2) Q:DGXX="QUIT"  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
  1.  K DIC,DGXX
  1.  ;
  1. INAC W !!,">>> Inactivating clinic stops in CLINIC STOP CODE FILE (#40.7)..."
  1.  W !,"    [NOTE:  These stop codes CANNOT be used AFTER 9/30/93]",!
  1.  D NOW^%DTC S SDATE=X
  1.  F DGX=1:1 K DD,DO,DA S DGXX=$P($T(INA+DGX),";;",2) Q:DGXX="QUIT"  S DGDA=+$O(^DIC(40.7,"C",DGXX,0)) I $D(^DIC(40.7,DGDA,0)) S DA=DGDA,DR="2////2931001",DIE="^DIC(40.7," D ^DIE,MESI
  1.  K %,%H,%I,DGX,DGDA,DR,DA,DIE,SDATE
  1.  ;
  1. CHANGE W !!,">>> Changing clinic stop names in CLINIC STOP CODE FILE (#40.7)..."
  1.  F DGX=1:1 K DD,DO,DA S DGXX=$P($T(CHNG+DGX),";;",2) Q:DGXX="QUIT"  I '$O(^DIC(40.7,"B",$P(DGXX,U,3),0)) S DGDA=+$O(^DIC(40.7,"B",$P(DGXX,U),0)) I $D(^DIC(40.7,DGDA,0)) S DA=DGDA,DR=".01///"_$P(DGXX,U,3),DIE="^DIC(40.7," D ^DIE,MESC
  1.  K DGX,DGXX,DGDA,DIE,DR,DA Q
  1.  ;
  1. MESI W !?8,"...",$P(^DIC(40.7,DGDA,0),"^"),?40,"(",DGXX,") inactivated as of 10/1/93..."
  1.  Q
  1.  ;
  1. MESS W !?8,"...",X,?40,"(",$P(DGXX,"^",2),") added..."
  1.  Q
  1.  ;
  1. MESC W !?8,"...",$P(DGXX,U)_$P(DGXX,U,2),?44,"changed to ",!?11,$P(DGXX,U,3),"..."
  1.  Q
  1.  ;
  1. SCS ;STOP CODES TO BE ADDED TO FILE
  1.  ;;RADIONUCLIDE THERAPY^144^^^2612.00
  1.  ;;PHARM/PHYSIO NMP STUDIES^145^^^2612.00
  1.  ;;PET^146^^^2612.00
  1.  ;;SCI HOME CARE PROGRAM^215^^^5112.00
  1.  ;;GERIATRIC EVAL. & MGMT. (GEM)^319^^^2110.00
  1.  ;;ALZHEIMER'S/DEMENTIA CLINIC^320^^^2110.00
  1.  ;;GI ENDOSCOPY^321^^^2110.00
  1.  ;;WOMEN'S CLINIC^322^^^2110.00
  1.  ;;PROSTHETIC SERVICES^423^^^2614.00
  1.  ;;SEXUAL TRAUMA COUNSELING^524^^^2311.00
  1.  ;;INCENTIVE THERAPY^573^^^2310.00
  1.  ;;COMPENSATED WORK THERAPY^574^^^2310.00
  1.  ;;VOCATIONAL ASSISTANCE^575^^^2310.00
  1.  ;;DOMICILIARY OUTREACH SERVCIES^725^^^5115.00
  1.  ;;DOM AFTERCARE - COMMUNITY^726^^^5115.00
  1.  ;;DOMICILIARY AFTERCARE - VA^727^^^2750.00
  1.  ;;QUIT
  1.  ;
  1. INA ;STOP CODES TO BE INACTIVATED
  1.  ;;511
  1.  ;;559
  1.  ;;QUIT
  1.  ;
  1. CHNG ;STOP CODES THAT ARE CHANGED
  1.  ;;RECREATION SERVICE^ (202)^RECREATION THERAPY SERVICE
  1.  ;;INCENTIVE THERAPY^ (207)^RMS INCENTIVE THERAPY
  1.  ;;COMPENSATED WORK THERAPY^ (208)^RMS COMPENSATED WORK THERAPY
  1.  ;;VOCATIONAL ASSISTANCE^ (213)^RMS VOCATIONAL ASSISTANCE
  1.  ;;CORRECTIVE THERAPY^ (214)^KINESIOTHERAPY
  1.  ;;CWT/ILH INDIVIDUAL^ (515)^CWT/TR-HCMI
  1.  ;;CWT/ILH SUBSTANCE ABUSE^ (518)^CWT/TR-SUBSTANCE ABUSE
  1.  ;;QUIT