| 1 | SROPOST1 ;B'HAM ISC/ADM - MOVE SPECIALTIES INTO LOCAL FILE ; 23-APR-92 15:15
|
|---|
| 2 | ;;3.0; Surgery ;**5,6**;24 Jun 93;Build 4
|
|---|
| 3 | ;Modified from FOIA VISTA,
|
|---|
| 4 | ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
|---|
| 5 | ;General Public License See attached copy of the License.
|
|---|
| 6 | ;
|
|---|
| 7 | ;This program is free software; you can redistribute it and/or modify
|
|---|
| 8 | ;it under the terms of the GNU General Public License as published by
|
|---|
| 9 | ;the Free Software Foundation; either version 2 of the License, or
|
|---|
| 10 | ;(at your option) any later version.
|
|---|
| 11 | ;
|
|---|
| 12 | ;This program is distributed in the hope that it will be useful,
|
|---|
| 13 | ;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|---|
| 14 | ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|---|
| 15 | ;GNU General Public License for more details.
|
|---|
| 16 | ;
|
|---|
| 17 | ;You should have received a copy of the GNU General Public License along
|
|---|
| 18 | ;with this program; if not, write to the Free Software Foundation, Inc.,
|
|---|
| 19 | ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|---|
| 20 | Q:'$D(^SRO(137.45,0))!($O(^SRO(137.45,0))) W !!,"Setting up Local Surgical Specialty file... "
|
|---|
| 21 | F I=50:1:62,500,501,502 S SRCODE(I)=I
|
|---|
| 22 | S SRSS=0 F S SRSS=$O(^DIC(45.3,SRSS)) Q:'SRSS S SRPTF=$P(^DIC(45.3,SRSS,0),"^") D FILE
|
|---|
| 23 | S SRLOCAL=0 F S SRLOCAL=$O(^SRO(137.45,SRLOCAL)) Q:'SRLOCAL D:SRL(SRLOCAL)'="" POINT D:SRL(SRLOCAL)="" SEL
|
|---|
| 24 | W !!,"Set-up of Local Specialty file completed."
|
|---|
| 25 | END K DA,DIC,DINUM,DR,I,SRCODE,SRL,SRLOCAL,SRPTF,SRSS,X
|
|---|
| 26 | Q
|
|---|
| 27 | FILE ;
|
|---|
| 28 | I '$D(SRCODE(SRPTF)) S SRPTF=""
|
|---|
| 29 | S X=$P(^DIC(45.3,SRSS,0),"^",2) K DIC S DIC="^SRO(137.45,",DIC(0)="L",DINUM=SRSS,DLAYGO=137.45 D FILE^DICN K DIC,DLAYGO Q:'+Y S SRL(+Y)=SRPTF
|
|---|
| 30 | Q
|
|---|
| 31 | POINT ;
|
|---|
| 32 | K DIC S X=SRL(SRLOCAL),DIC=45.3,DIC(0)="" D ^DIC K DIC I Y<0 S SRL(SRLOCAL)="" Q
|
|---|
| 33 | K DD,DO,DA,DR S DA=SRLOCAL,DR="1///"_SRL(SRLOCAL),DIE=137.45 D ^DIE K DIE
|
|---|
| 34 | Q
|
|---|
| 35 | SEL W !!,"Point Local Surgical Specialty ",$P(^SRO(137.45,SRLOCAL,0),"^"),!," to what National Surgical Specialty ?",!
|
|---|
| 36 | W "(Note!! If no entry is made it will be pointed automatically",!,"to the National Surgical Specialty ",$P(^DIC(45.3,1,0),"^",2),".)"
|
|---|
| 37 | K DD,DO,DA,DINUM S DA=SRLOCAL,DIE=137.45,DR="1T//"_$E($P(^DIC(45.3,1,0),"^",2),1,30) D ^DIE K DIE
|
|---|
| 38 | I '$P(^SRO(137.45,SRLOCAL,0),"^",2) K DD,DO,DA,DINUM S DA=SRLOCAL,DIE=137.45,DR="1////1" D ^DIE K DIE
|
|---|
| 39 | Q
|
|---|
| 40 | AMM ; Logic for SR*3*6 if Surgery v3 is already installed
|
|---|
| 41 | D WAIT^DICD K ^SRF("AMM") S SRTN=0
|
|---|
| 42 | ; F S SRTN=$O(^SRF(SRTN)) Q:SRTN'>0 I $D(^SRF(SRTN,0)),$P($G(^S,5) D SET11
|
|---|
| 43 | F S SRTN=$O(^SRF(SRTN)) Q:SRTN'>0 I $D(^SRF(SRTN,0)),$P($G(^SRF(SRTN,0)),"^",5) D SET11
|
|---|
| 44 | W !!,"Process is finished." K DA,DIK,SRSTART,SRTN
|
|---|
| 45 | Q
|
|---|
| 46 | SET11 ; Convert SCHEDULE START TIME to numeric form and re-index AMM
|
|---|
| 47 | ; This code is pretty compromised and needs to be re-factored.
|
|---|
| 48 | ; S SRSTART=$P(^SRF(SRTN,31),"^",4) Q:SRSTART="" I SRSTART'=+SRSRTN,31),"^",4)=+SRSTART
|
|---|
| 49 | S SRSTART=$P(^SRF(SRTN,31),"^",4) Q:SRSTART="" I SRSTART'=+SRSTART,$P(^SRF(SRTN,31),"^",4)=+SRSTART
|
|---|
| 50 | Q:$P(^SRF(SRTN,0),"^",2)=""
|
|---|
| 51 | K DA,DIK S DIK="^SRF(",DIK(1)="11^AMM",DA=SRTN D EN1^DIK
|
|---|
| 52 | Q
|
|---|
