- SD628PST ;ALB/BNT - Scheduling Enhancements Post Install Routine ;11/04/2014
- ;;5.3;Scheduling;**628**;Aug 13, 1993;Build 371
- ;
- Q
- ;
- POST ; Entry point for post install
- D MES^XPDUTL(" Starting post-install of SD*5.3*628")
- ;
- STPCDS ; Set up default PRIMARY CARE STOP CODES
- N LIST,X
- D REMSTP
- ;
- ; Set up Primary Care Stop Codes
- D GETLST^XPAR(.LIST,"PKG.SCHEDULING","SDEC PRIMARY CARE STOP CODES","B")
- I $G(LIST)=0 D SETPCDEF
- ; Display current Primary Care Stop Codes
- I +$G(LIST) D
- . W ! D MES^XPDUTL(" Active Primary Care Stop Codes...")
- . S X="" F S X=$O(LIST(X)) Q:X="" I $P(LIST(X,"V"),U) D
- . . D MES^XPDUTL(" - "_$P(LIST(X,"N"),U,2))
- ;
- ; Set up Specialty Care Stop Codes
- N LIST,X D GETLST^XPAR(.LIST,"PKG.SCHEDULING","SDEC SPECIALTY CARE STOP CODES","B")
- I $G(LIST)=0 D SETSCDEF
- ; Display current Specialty Care Stop Codes
- I +$G(LIST) D
- . W ! D MES^XPDUTL(" Active Specialty Care Stop Codes...")
- . S X="" F S X=$O(LIST(X)) Q:X="" I $P(LIST(X,"V"),U) D
- . . D MES^XPDUTL(" - "_$P(LIST(X,"N"),U,2))
- ;
- ; Set up Mental Health Stop Codes
- N LIST,X D GETLST^XPAR(.LIST,"PKG.SCHEDULING","SDEC MENTAL HEALTH STOP CODES","B")
- I $G(LIST)=0 D SETMHDEF
- ; Display current Mental Health Stop Codes
- I +$G(LIST) D
- . W ! D MES^XPDUTL(" Active Mental Health Stop Codes...")
- . S X="" F S X=$O(LIST(X)) Q:X="" I $P(LIST(X,"V"),U) D
- . . D MES^XPDUTL(" - "_$P(LIST(X,"N"),U,2))
- ;
- F REGRPC="SD VSE FILTER RPC","SD VSE REPORT RPC" D REGRPC(REGRPC,"SDECRPC")
- ;
- ; Schedule background build of data in ^TMP
- D SCHTSK("SDEC REPORT DATA")
- ;
- ; Build VSE Encounter and Appointment Data from Scheduling files into ^XTMP
- ; Remove old ^XTMP files first
- K ^XTMP("SDVSE"),^XTMP("SDCEX"),^TMP("SDCEX"),^TMP("SDVSE"),^TMP("SDRPC")
- W !,"Queuing job to Re-Index the OUTPATIENT ENCOUNTER file (#409.68)"
- W !,"Queuing job to build VSE GUI Resource Management Report data"
- N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
- S ZTIO=""
- S ZTRTN="TSKINDX^SD628PST"
- S ZTDTH=$$NOW^XLFDT
- S ZTDESC="SD*5.3*628 Post Init Data Compiler"
- D ^%ZTLOAD
- Q
- ;
- TSKINDX ; Re-Index the Outpatient Encounter file then start background job to compile report data
- ; If the 'D' new style index does not exist then re-index file 409.68
- N SDECMAIL S SDECMAIL=1 ; Flag to send data collection statistics mail message to installer.
- I '$D(^SCE("D")) N DIK S DIK="^SCE(",DIK(1)=".01^D" D ENALL^DIK
- ; Run the Resource Management Report Compiler
- D EN^SDCED
- Q
- ;
- SCHTSK(OPTNAME) ; Schedule Option
- N SCHNM,DIC,X,Y,SDIEN S SDIEN=""
- Q:$G(OPTNAME)=""
- S DIC(0)="I",X=OPTNAME,DIC="^DIC(19,"
- D ^DIC Q:'(Y>0) S SCHNM=+Y
- ;D CLEAN^DILF
- S FDA(19.2,"?+1,",.01)=SCHNM,X=SCHNM
- I 'SCHNM D Q
- .W !,OPTNAME," option can't be scheduled - option does not exist"
- S FDA(19.2,"?+1,",1)=SCHNM
- S FDA(19.2,"?+1,",2)=$P($$NOW^XLFDT,".")_".03"
- S FDA(19.2,"?+1,",6)="1D"
- D UPDATE^DIE("","FDA","SDIEN")
- W !,"Scheduled option ",OPTNAME
- D CLEAN^DILF
- ; Set the ^XTMP("SDECMAIL",0) Global with the user ID of installer
- S ^XTMP("SDECMAIL",0)=$$FMADD^XLFDT($$NOW^XLFDT,7,0,0,)_"^"_+$G(DUZ)
- Q
- ;
- SETPCDEF ; Create the default SCHEDULING PRIMARY CARE STOP CODE list
- N LINE,NUM,DATA,DESC,ERR,AMIS,IEN
- D MES^XPDUTL(" Activating Default Primary Care Stop Codes...")
- F LINE=1:1 S DATA=$P($T(DFPCPRMS+LINE),";;",2,99) Q:DATA="" D
- . S AMIS=$P(DATA,U),DESC=$P(DATA,U,2),IEN=$O(^DIC(40.7,"C",AMIS,0))
- . S ERR=0
- . D EN^XPAR("PKG.SCHEDULING","SDEC PRIMARY CARE STOP CODES","`"_+IEN,1,.ERR)
- . I 'ERR D MES^XPDUTL(" - Activated "_DESC) Q
- . E D MES^XPDUTL(" - Error Activating "_DESC)
- Q
- ;
- SETSCDEF ; Create the default SCHEDULING SPECIALTY CARE STOP CODE list
- N LINE,NUM,DATA,DESC,ERR,AMIS,IEN
- W ! D MES^XPDUTL(" Activating Default Specialty Care Stop Codes...")
- F LINE=1:1 S DATA=$P($T(DFSCPRMS+LINE),";;",2,99) Q:DATA="" D
- . S AMIS=$P(DATA,U),DESC=$P(DATA,U,2),IEN=$O(^DIC(40.7,"C",AMIS,0))
- . S ERR=0
- . D EN^XPAR("PKG.SCHEDULING","SDEC SPECIALTY CARE STOP CODES","`"_+IEN,1,.ERR)
- . I 'ERR D MES^XPDUTL(" - Activated "_DESC) Q
- . E D MES^XPDUTL(" - Error Activating "_DESC)
- Q
- ;
- SETMHDEF ; Create the default SCHEDULING MENTAL HEALTH STOP CODE list
- N LINE,NUM,DATA,DESC,ERR,AMIS,IEN
- W ! D MES^XPDUTL(" Activating Default Mental Health Stop Codes...")
- F LINE=1:1 S DATA=$P($T(DFMHPRMS+LINE),";;",2,99) Q:DATA="" D
- . S AMIS=$P(DATA,U),DESC=$P(DATA,U,2),IEN=$O(^DIC(40.7,"C",AMIS,0))
- . S ERR=0
- . D EN^XPAR("PKG.SCHEDULING","SDEC MENTAL HEALTH STOP CODES","`"_+IEN,1,.ERR)
- . I 'ERR D MES^XPDUTL(" - Activated "_DESC) Q
- . E D MES^XPDUTL(" - Error Activating "_DESC)
- Q
- ;
- REMSTP ; Remove the SCHEDULING STOP CODE list
- N LINE,NUM,DATA,DESC,ERR,CNT
- W ! D GETLST^XPAR(.LIST,"PKG.SCHEDULING","SDEC PRIMARY CARE STOP CODES","B")
- I +$G(LIST) D
- . S CNT=0 F S CNT=$O(LIST(CNT)) Q:CNT="" D
- . . S NUM=$P(LIST(CNT,"N"),U),DESC=$P(LIST(CNT,"N"),U,2),ERR=0
- . . D EN^XPAR("PKG.SCHEDULING","SDEC PRIMARY CARE STOP CODES","`"_+NUM,"@",.ERR)
- D GETLST^XPAR(.LIST,"PKG.SCHEDULING","SDEC SPECIALTY CARE STOP CODES","B")
- I +$G(LIST) D
- . S CNT=0 F S CNT=$O(LIST(CNT)) Q:CNT="" D
- . . S NUM=$P(LIST(CNT,"N"),U),DESC=$P(LIST(CNT,"N"),U,2),ERR=0
- . . D EN^XPAR("PKG.SCHEDULING","SDEC SPECIALTY CARE STOP CODES","`"_+NUM,"@",.ERR)
- D GETLST^XPAR(.LIST,"PKG.SCHEDULING","SDEC MENTAL HEALTH STOP CODES","B")
- I +$G(LIST) D
- . S CNT=0 F S CNT=$O(LIST(CNT)) Q:CNT="" D
- . . S NUM=$P(LIST(CNT,"N"),U),DESC=$P(LIST(CNT,"N"),U,2),ERR=0
- . . D EN^XPAR("PKG.SCHEDULING","SDEC MENTAL HEALTH STOP CODES","`"_+NUM,"@",.ERR)
- Q
- ;
- REGRPC(REGRPC,REGOPT) ; Register RPC
- N X,Y,DIC,FDA,RPCIEN,OPTIEN,SDIEN
- Q:$G(REGRPC)=""!($G(REGOPT)="")
- S DIC(0)="I",X=REGRPC,DIC="^XWB(8994,"
- D ^DIC Q:'(Y>0) S RPCIEN=+Y
- D CLEAN^DILF
- S DIC(0)="I",X=REGOPT,DIC="^DIC(19,"
- D ^DIC Q:'(Y>0) S OPTIEN=+Y
- D CLEAN^DILF
- S FDA(19.05,"?+1,"_OPTIEN_",",.01)=RPCIEN
- D UPDATE^DIE("","FDA","SDIEN")
- W !,"Added RPC ",REGRPC," to option ",REGOPT
- Q
- ;
- DFPCPRMS ;
- ;;322^Comprehensive Women's Primary Care Clinic
- ;;323^Primary Care/Medicine
- ;;350^GeriPACT
- Q
- ;
- DFSCPRMS ;
- ;;123^NUTRITION/DIETETICS-INDIVIDUAL
- ;;149^Radiation Therapy Treatment
- ;;180^Dental
- ;;197^POLYTRAUMA/TRAUMATIC BRAIN INJURY (TBI)-INDI
- ;;201^PHYSICAL MED & REHAB SVC
- ;;203^AUDIOLOGY
- ;;204^SPEECH LANGUAGE PATHOLOGY
- ;;205^PHYSICAL THERAPY
- ;;206^OCCUPATIONAL THERAPY
- ;;210^SPINAL CORD INJURY
- ;;214^KINESIOTHERAPY
- ;;301^GENERAL INTERNAL MEDICINE
- ;;302^ALLERGY IMMUNOLOGY
- ;;303^CARDIOLOGY
- ;;304^DERMATOLOGY
- ;;305^ENDO/METAB (EXCEPT DIABETES)
- ;;306^DIABETES
- ;;307^GASTROENTEROLOGY
- ;;308^HEMATOLOGY
- ;;310^INFECTIOUS DISEASE
- ;;312^PULMONARY/CHEST
- ;;313^RENAL/NEPHROL (EXCEPT DIALYSIS)
- ;;314^RHEUMATOLOGY/ARTHRITIS
- ;;315^NEUROLOGY
- ;;316^ONCOLOGY/TUMOR
- ;;317^ANTI-COAGULATION CLINIC
- ;;318^Geriatric Problem-Focused Clinic
- ;;337^HEPATOLOGY CLINIC
- ;;401^GENERAL SURGERY
- ;;403^ENT
- ;;404^GYNECOLOGY
- ;;406^NEUROSURGERY
- ;;407^OPHTHALMOLOGY
- ;;408^OPTOMETRY
- ;;409^ORTHOPEDICS
- ;;410^PLASTIC SURGERY
- ;;411^PODIATRY
- ;;413^THORACIC SURGERY
- ;;414^UROLOGY
- ;;415^VASCULAR SURGERY
- ;;420^PAIN CLINIC
- Q
- ;
- DFMHPRMS ;
- ;;502^MH CLINIC IND
- ;;509^PSYCHIATRY INDIV
- ;;510^PSYCHOLOGY IND
- ;;513^SUB USE DISORDER INDIV
- ;;540^PCT-PTSD IND
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD628PST 7393 printed Feb 19, 2025@00:13:17 Page 2
- SD628PST ;ALB/BNT - Scheduling Enhancements Post Install Routine ;11/04/2014
- +1 ;;5.3;Scheduling;**628**;Aug 13, 1993;Build 371
- +2 ;
- +3 QUIT
- +4 ;
- POST ; Entry point for post install
- +1 DO MES^XPDUTL(" Starting post-install of SD*5.3*628")
- +2 ;
- STPCDS ; Set up default PRIMARY CARE STOP CODES
- +1 NEW LIST,X
- +2 DO REMSTP
- +3 ;
- +4 ; Set up Primary Care Stop Codes
- +5 DO GETLST^XPAR(.LIST,"PKG.SCHEDULING","SDEC PRIMARY CARE STOP CODES","B")
- +6 IF $GET(LIST)=0
- DO SETPCDEF
- +7 ; Display current Primary Care Stop Codes
- +8 IF +$GET(LIST)
- Begin DoDot:1
- +9 WRITE !
- DO MES^XPDUTL(" Active Primary Care Stop Codes...")
- +10 SET X=""
- FOR
- SET X=$ORDER(LIST(X))
- if X=""
- QUIT
- IF $PIECE(LIST(X,"V"),U)
- Begin DoDot:2
- +11 DO MES^XPDUTL(" - "_$PIECE(LIST(X,"N"),U,2))
- End DoDot:2
- End DoDot:1
- +12 ;
- +13 ; Set up Specialty Care Stop Codes
- +14 NEW LIST,X
- DO GETLST^XPAR(.LIST,"PKG.SCHEDULING","SDEC SPECIALTY CARE STOP CODES","B")
- +15 IF $GET(LIST)=0
- DO SETSCDEF
- +16 ; Display current Specialty Care Stop Codes
- +17 IF +$GET(LIST)
- Begin DoDot:1
- +18 WRITE !
- DO MES^XPDUTL(" Active Specialty Care Stop Codes...")
- +19 SET X=""
- FOR
- SET X=$ORDER(LIST(X))
- if X=""
- QUIT
- IF $PIECE(LIST(X,"V"),U)
- Begin DoDot:2
- +20 DO MES^XPDUTL(" - "_$PIECE(LIST(X,"N"),U,2))
- End DoDot:2
- End DoDot:1
- +21 ;
- +22 ; Set up Mental Health Stop Codes
- +23 NEW LIST,X
- DO GETLST^XPAR(.LIST,"PKG.SCHEDULING","SDEC MENTAL HEALTH STOP CODES","B")
- +24 IF $GET(LIST)=0
- DO SETMHDEF
- +25 ; Display current Mental Health Stop Codes
- +26 IF +$GET(LIST)
- Begin DoDot:1
- +27 WRITE !
- DO MES^XPDUTL(" Active Mental Health Stop Codes...")
- +28 SET X=""
- FOR
- SET X=$ORDER(LIST(X))
- if X=""
- QUIT
- IF $PIECE(LIST(X,"V"),U)
- Begin DoDot:2
- +29 DO MES^XPDUTL(" - "_$PIECE(LIST(X,"N"),U,2))
- End DoDot:2
- End DoDot:1
- +30 ;
- +31 FOR REGRPC="SD VSE FILTER RPC","SD VSE REPORT RPC"
- DO REGRPC(REGRPC,"SDECRPC")
- +32 ;
- +33 ; Schedule background build of data in ^TMP
- +34 DO SCHTSK("SDEC REPORT DATA")
- +35 ;
- +36 ; Build VSE Encounter and Appointment Data from Scheduling files into ^XTMP
- +37 ; Remove old ^XTMP files first
- +38 KILL ^XTMP("SDVSE"),^XTMP("SDCEX"),^TMP("SDCEX"),^TMP("SDVSE"),^TMP("SDRPC")
- +39 WRITE !,"Queuing job to Re-Index the OUTPATIENT ENCOUNTER file (#409.68)"
- +40 WRITE !,"Queuing job to build VSE GUI Resource Management Report data"
- +41 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
- +42 SET ZTIO=""
- +43 SET ZTRTN="TSKINDX^SD628PST"
- +44 SET ZTDTH=$$NOW^XLFDT
- +45 SET ZTDESC="SD*5.3*628 Post Init Data Compiler"
- +46 DO ^%ZTLOAD
- +47 QUIT
- +48 ;
- TSKINDX ; Re-Index the Outpatient Encounter file then start background job to compile report data
- +1 ; If the 'D' new style index does not exist then re-index file 409.68
- +2 ; Flag to send data collection statistics mail message to installer.
- NEW SDECMAIL
- SET SDECMAIL=1
- +3 IF '$DATA(^SCE("D"))
- NEW DIK
- SET DIK="^SCE("
- SET DIK(1)=".01^D"
- DO ENALL^DIK
- +4 ; Run the Resource Management Report Compiler
- +5 DO EN^SDCED
- +6 QUIT
- +7 ;
- SCHTSK(OPTNAME) ; Schedule Option
- +1 NEW SCHNM,DIC,X,Y,SDIEN
- SET SDIEN=""
- +2 if $GET(OPTNAME)=""
- QUIT
- +3 SET DIC(0)="I"
- SET X=OPTNAME
- SET DIC="^DIC(19,"
- +4 DO ^DIC
- if '(Y>0)
- QUIT
- SET SCHNM=+Y
- +5 ;D CLEAN^DILF
- +6 SET FDA(19.2,"?+1,",.01)=SCHNM
- SET X=SCHNM
- +7 IF 'SCHNM
- Begin DoDot:1
- +8 WRITE !,OPTNAME," option can't be scheduled - option does not exist"
- End DoDot:1
- QUIT
- +9 SET FDA(19.2,"?+1,",1)=SCHNM
- +10 SET FDA(19.2,"?+1,",2)=$PIECE($$NOW^XLFDT,".")_".03"
- +11 SET FDA(19.2,"?+1,",6)="1D"
- +12 DO UPDATE^DIE("","FDA","SDIEN")
- +13 WRITE !,"Scheduled option ",OPTNAME
- +14 DO CLEAN^DILF
- +15 ; Set the ^XTMP("SDECMAIL",0) Global with the user ID of installer
- +16 SET ^XTMP("SDECMAIL",0)=$$FMADD^XLFDT($$NOW^XLFDT,7,0,0,)_"^"_+$GET(DUZ)
- +17 QUIT
- +18 ;
- SETPCDEF ; Create the default SCHEDULING PRIMARY CARE STOP CODE list
- +1 NEW LINE,NUM,DATA,DESC,ERR,AMIS,IEN
- +2 DO MES^XPDUTL(" Activating Default Primary Care Stop Codes...")
- +3 FOR LINE=1:1
- SET DATA=$PIECE($TEXT(DFPCPRMS+LINE),";;",2,99)
- if DATA=""
- QUIT
- Begin DoDot:1
- +4 SET AMIS=$PIECE(DATA,U)
- SET DESC=$PIECE(DATA,U,2)
- SET IEN=$ORDER(^DIC(40.7,"C",AMIS,0))
- +5 SET ERR=0
- +6 DO EN^XPAR("PKG.SCHEDULING","SDEC PRIMARY CARE STOP CODES","`"_+IEN,1,.ERR)
- +7 IF 'ERR
- DO MES^XPDUTL(" - Activated "_DESC)
- QUIT
- +8 IF '$TEST
- DO MES^XPDUTL(" - Error Activating "_DESC)
- End DoDot:1
- +9 QUIT
- +10 ;
- SETSCDEF ; Create the default SCHEDULING SPECIALTY CARE STOP CODE list
- +1 NEW LINE,NUM,DATA,DESC,ERR,AMIS,IEN
- +2 WRITE !
- DO MES^XPDUTL(" Activating Default Specialty Care Stop Codes...")
- +3 FOR LINE=1:1
- SET DATA=$PIECE($TEXT(DFSCPRMS+LINE),";;",2,99)
- if DATA=""
- QUIT
- Begin DoDot:1
- +4 SET AMIS=$PIECE(DATA,U)
- SET DESC=$PIECE(DATA,U,2)
- SET IEN=$ORDER(^DIC(40.7,"C",AMIS,0))
- +5 SET ERR=0
- +6 DO EN^XPAR("PKG.SCHEDULING","SDEC SPECIALTY CARE STOP CODES","`"_+IEN,1,.ERR)
- +7 IF 'ERR
- DO MES^XPDUTL(" - Activated "_DESC)
- QUIT
- +8 IF '$TEST
- DO MES^XPDUTL(" - Error Activating "_DESC)
- End DoDot:1
- +9 QUIT
- +10 ;
- SETMHDEF ; Create the default SCHEDULING MENTAL HEALTH STOP CODE list
- +1 NEW LINE,NUM,DATA,DESC,ERR,AMIS,IEN
- +2 WRITE !
- DO MES^XPDUTL(" Activating Default Mental Health Stop Codes...")
- +3 FOR LINE=1:1
- SET DATA=$PIECE($TEXT(DFMHPRMS+LINE),";;",2,99)
- if DATA=""
- QUIT
- Begin DoDot:1
- +4 SET AMIS=$PIECE(DATA,U)
- SET DESC=$PIECE(DATA,U,2)
- SET IEN=$ORDER(^DIC(40.7,"C",AMIS,0))
- +5 SET ERR=0
- +6 DO EN^XPAR("PKG.SCHEDULING","SDEC MENTAL HEALTH STOP CODES","`"_+IEN,1,.ERR)
- +7 IF 'ERR
- DO MES^XPDUTL(" - Activated "_DESC)
- QUIT
- +8 IF '$TEST
- DO MES^XPDUTL(" - Error Activating "_DESC)
- End DoDot:1
- +9 QUIT
- +10 ;
- REMSTP ; Remove the SCHEDULING STOP CODE list
- +1 NEW LINE,NUM,DATA,DESC,ERR,CNT
- +2 WRITE !
- DO GETLST^XPAR(.LIST,"PKG.SCHEDULING","SDEC PRIMARY CARE STOP CODES","B")
- +3 IF +$GET(LIST)
- Begin DoDot:1
- +4 SET CNT=0
- FOR
- SET CNT=$ORDER(LIST(CNT))
- if CNT=""
- QUIT
- Begin DoDot:2
- +5 SET NUM=$PIECE(LIST(CNT,"N"),U)
- SET DESC=$PIECE(LIST(CNT,"N"),U,2)
- SET ERR=0
- +6 DO EN^XPAR("PKG.SCHEDULING","SDEC PRIMARY CARE STOP CODES","`"_+NUM,"@",.ERR)
- End DoDot:2
- End DoDot:1
- +7 DO GETLST^XPAR(.LIST,"PKG.SCHEDULING","SDEC SPECIALTY CARE STOP CODES","B")
- +8 IF +$GET(LIST)
- Begin DoDot:1
- +9 SET CNT=0
- FOR
- SET CNT=$ORDER(LIST(CNT))
- if CNT=""
- QUIT
- Begin DoDot:2
- +10 SET NUM=$PIECE(LIST(CNT,"N"),U)
- SET DESC=$PIECE(LIST(CNT,"N"),U,2)
- SET ERR=0
- +11 DO EN^XPAR("PKG.SCHEDULING","SDEC SPECIALTY CARE STOP CODES","`"_+NUM,"@",.ERR)
- End DoDot:2
- End DoDot:1
- +12 DO GETLST^XPAR(.LIST,"PKG.SCHEDULING","SDEC MENTAL HEALTH STOP CODES","B")
- +13 IF +$GET(LIST)
- Begin DoDot:1
- +14 SET CNT=0
- FOR
- SET CNT=$ORDER(LIST(CNT))
- if CNT=""
- QUIT
- Begin DoDot:2
- +15 SET NUM=$PIECE(LIST(CNT,"N"),U)
- SET DESC=$PIECE(LIST(CNT,"N"),U,2)
- SET ERR=0
- +16 DO EN^XPAR("PKG.SCHEDULING","SDEC MENTAL HEALTH STOP CODES","`"_+NUM,"@",.ERR)
- End DoDot:2
- End DoDot:1
- +17 QUIT
- +18 ;
- REGRPC(REGRPC,REGOPT) ; Register RPC
- +1 NEW X,Y,DIC,FDA,RPCIEN,OPTIEN,SDIEN
- +2 if $GET(REGRPC)=""!($GET(REGOPT)="")
- QUIT
- +3 SET DIC(0)="I"
- SET X=REGRPC
- SET DIC="^XWB(8994,"
- +4 DO ^DIC
- if '(Y>0)
- QUIT
- SET RPCIEN=+Y
- +5 DO CLEAN^DILF
- +6 SET DIC(0)="I"
- SET X=REGOPT
- SET DIC="^DIC(19,"
- +7 DO ^DIC
- if '(Y>0)
- QUIT
- SET OPTIEN=+Y
- +8 DO CLEAN^DILF
- +9 SET FDA(19.05,"?+1,"_OPTIEN_",",.01)=RPCIEN
- +10 DO UPDATE^DIE("","FDA","SDIEN")
- +11 WRITE !,"Added RPC ",REGRPC," to option ",REGOPT
- +12 QUIT
- +13 ;
- DFPCPRMS ;
- +1 ;;322^Comprehensive Women's Primary Care Clinic
- +2 ;;323^Primary Care/Medicine
- +3 ;;350^GeriPACT
- +4 QUIT
- +5 ;
- DFSCPRMS ;
- +1 ;;123^NUTRITION/DIETETICS-INDIVIDUAL
- +2 ;;149^Radiation Therapy Treatment
- +3 ;;180^Dental
- +4 ;;197^POLYTRAUMA/TRAUMATIC BRAIN INJURY (TBI)-INDI
- +5 ;;201^PHYSICAL MED & REHAB SVC
- +6 ;;203^AUDIOLOGY
- +7 ;;204^SPEECH LANGUAGE PATHOLOGY
- +8 ;;205^PHYSICAL THERAPY
- +9 ;;206^OCCUPATIONAL THERAPY
- +10 ;;210^SPINAL CORD INJURY
- +11 ;;214^KINESIOTHERAPY
- +12 ;;301^GENERAL INTERNAL MEDICINE
- +13 ;;302^ALLERGY IMMUNOLOGY
- +14 ;;303^CARDIOLOGY
- +15 ;;304^DERMATOLOGY
- +16 ;;305^ENDO/METAB (EXCEPT DIABETES)
- +17 ;;306^DIABETES
- +18 ;;307^GASTROENTEROLOGY
- +19 ;;308^HEMATOLOGY
- +20 ;;310^INFECTIOUS DISEASE
- +21 ;;312^PULMONARY/CHEST
- +22 ;;313^RENAL/NEPHROL (EXCEPT DIALYSIS)
- +23 ;;314^RHEUMATOLOGY/ARTHRITIS
- +24 ;;315^NEUROLOGY
- +25 ;;316^ONCOLOGY/TUMOR
- +26 ;;317^ANTI-COAGULATION CLINIC
- +27 ;;318^Geriatric Problem-Focused Clinic
- +28 ;;337^HEPATOLOGY CLINIC
- +29 ;;401^GENERAL SURGERY
- +30 ;;403^ENT
- +31 ;;404^GYNECOLOGY
- +32 ;;406^NEUROSURGERY
- +33 ;;407^OPHTHALMOLOGY
- +34 ;;408^OPTOMETRY
- +35 ;;409^ORTHOPEDICS
- +36 ;;410^PLASTIC SURGERY
- +37 ;;411^PODIATRY
- +38 ;;413^THORACIC SURGERY
- +39 ;;414^UROLOGY
- +40 ;;415^VASCULAR SURGERY
- +41 ;;420^PAIN CLINIC
- +42 QUIT
- +43 ;
- DFMHPRMS ;
- +1 ;;502^MH CLINIC IND
- +2 ;;509^PSYCHIATRY INDIV
- +3 ;;510^PSYCHOLOGY IND
- +4 ;;513^SUB USE DISORDER INDIV
- +5 ;;540^PCT-PTSD IND
- +6 QUIT