PSOSTART ;BHAM ISC/SAB - pre init for v7 ;2/28/95 [ 07/29/96 9:15 AM ]
;;7.0;OUTPATIENT PHARMACY;**10**;DEC 1997
;this routine should only called by the KIDS installer
;Q:'$G(PSOINST)
S (XQABT1,XQABT2,XQABT3)=$H,PSOIT=$P(XQABT1,",",2)
;master file update
;D EN1^PSSHL1 I $G(XPDABORT) K XQABT1,XQABT2,XQABT3 Q
D:$P(^PS(59.7,1,49.99),"^")'="7.0"
.S $P(^PS(59.7,1,49.99),"^",7)="",ZTDTH=$H,ZTRTN="POST^PSOPOST",ZTIO="",ZTDESC="Outpatient Pharmacy version 7.0 background conversion" D ^%ZTLOAD
.S DIU(0)="DT" F DIU=52.41 D EN^DIU2 K DIU W "." ;deletes *REFILL WITH NON VERIFIED NEWS (#52.41) file
K DIK,DA S DIK="^DD(52,",DA(1)=52 F DA=6,17,39.4,39.5 D ^DIK
K DIK,DA S DIK="^DD(59,",DA(1)=59 F DA=.19,.093 D ^DIK
K DIK,DA S DIK="^DD(52.11,",DA(1)=52.11 F DA=.01,1,4,6,7,8 D ^DIK
K DIK,DA S DIK="^DD(59.3,",DA(1)=59.3,DA=2 D ^DIK
K DA,DIK F DA=3,4,5,6,7 S DIK="^DD(50.9006,",DA(1)=50.9006 D ^DIK ;deletes duplicate fields in 50.9
K DIK,DA
I $P($G(^PS(54,0)),"^")'="RX CONSULT" D W "."
.K ^PS(54)
.S %X="^DIC(54,",%Y="^PS(54," D %XY^%RCR K ^PS(54,0,"GL"),^PS(54,"%"),^PS(54,"%D") K ^DIC(54,"B") F I=0:0 S I=$O(^DIC(54,I)) Q:'I K ^DIC(54,I)
.S DIU="^DIC(54,",DIU(0)="" D EN^DIU2
S DIU(0)="DT" F DIU=59.9 D EN^DIU2 K DIU W "." ;deletes pharmacy functions file
K ^PSRX("AP"),DA,DIK S DIK="^DD(52,",DA(1)=52 F DA=10,100 D ;removes old sig and status fields
.I DA=10,$P($G(^DD(52,10,0)),"^",4)'="SIG;1" D ^DIK W "."
.I DA=100,$P($G(^DD(52,100,0)),"^",4)'="STA;1" D ^DIK W "."
;delete Pharmacy Archive data
K DA,DIK S DIK="^PSOARC(" F DA=0:0 S DA=$O(^PSOARC(DA)) Q:'DA D
.I $P($G(^PSOARC(DA,0)),"^"),$P($G(^(0)),"^",2),$D(^PSRX(DA,0)),$P($G(^(0)),"^",2) D ^DIK Q
.K ^PSOARC(DA,0)
K ^PSOARC("B"),^PSOARC("C")
K DA,DIK
Q
PSOSTART ;BHAM ISC/SAB - pre init for v7 ;2/28/95 [ 07/29/96 9:15 AM ]
+1 ;;7.0;OUTPATIENT PHARMACY;**10**;DEC 1997
+2 ;this routine should only called by the KIDS installer
+3 ;Q:'$G(PSOINST)
+4 SET (XQABT1,XQABT2,XQABT3)=$HOROLOG
SET PSOIT=$PIECE(XQABT1,",",2)
+5 ;master file update
+6 ;D EN1^PSSHL1 I $G(XPDABORT) K XQABT1,XQABT2,XQABT3 Q
+7 IF $PIECE(^PS(59.7,1,49.99),"^")'="7.0"
Begin DoDot:1
+8 SET $PIECE(^PS(59.7,1,49.99),"^",7)=""
SET ZTDTH=$HOROLOG
SET ZTRTN="POST^PSOPOST"
SET ZTIO=""
SET ZTDESC="Outpatient Pharmacy version 7.0 background conversion"
DO ^%ZTLOAD
+9 ;deletes *REFILL WITH NON VERIFIED NEWS (#52.41) file
SET DIU(0)="DT"
FOR DIU=52.41
DO EN^DIU2
KILL DIU
WRITE "."
End DoDot:1
+10 KILL DIK,DA
SET DIK="^DD(52,"
SET DA(1)=52
FOR DA=6,17,39.4,39.5
DO ^DIK
+11 KILL DIK,DA
SET DIK="^DD(59,"
SET DA(1)=59
FOR DA=.19,.093
DO ^DIK
+12 KILL DIK,DA
SET DIK="^DD(52.11,"
SET DA(1)=52.11
FOR DA=.01,1,4,6,7,8
DO ^DIK
+13 KILL DIK,DA
SET DIK="^DD(59.3,"
SET DA(1)=59.3
SET DA=2
DO ^DIK
+14 ;deletes duplicate fields in 50.9
KILL DA,DIK
FOR DA=3,4,5,6,7
SET DIK="^DD(50.9006,"
SET DA(1)=50.9006
DO ^DIK
+15 KILL DIK,DA
+16 IF $PIECE($GET(^PS(54,0)),"^")'="RX CONSULT"
Begin DoDot:1
+17 KILL ^PS(54)
+18 SET %X="^DIC(54,"
SET %Y="^PS(54,"
DO %XY^%RCR
KILL ^PS(54,0,"GL"),^PS(54,"%"),^PS(54,"%D")
KILL ^DIC(54,"B")
FOR I=0:0
SET I=$ORDER(^DIC(54,I))
IF 'I
QUIT
KILL ^DIC(54,I)
+19 SET DIU="^DIC(54,"
SET DIU(0)=""
DO EN^DIU2
End DoDot:1
WRITE "."
+20 ;deletes pharmacy functions file
SET DIU(0)="DT"
FOR DIU=59.9
DO EN^DIU2
KILL DIU
WRITE "."
+21 ;removes old sig and status fields
KILL ^PSRX("AP"),DA,DIK
SET DIK="^DD(52,"
SET DA(1)=52
FOR DA=10,100
Begin DoDot:1
+22 IF DA=10
IF $PIECE($GET(^DD(52,10,0)),"^",4)'="SIG;1"
DO ^DIK
WRITE "."
+23 IF DA=100
IF $PIECE($GET(^DD(52,100,0)),"^",4)'="STA;1"
DO ^DIK
WRITE "."
End DoDot:1
+24 ;delete Pharmacy Archive data
+25 KILL DA,DIK
SET DIK="^PSOARC("
FOR DA=0:0
SET DA=$ORDER(^PSOARC(DA))
IF 'DA
QUIT
Begin DoDot:1
+26 IF $PIECE($GET(^PSOARC(DA,0)),"^")
IF $PIECE($GET(^(0)),"^",2)
IF $DATA(^PSRX(DA,0))
IF $PIECE($GET(^(0)),"^",2)
DO ^DIK
QUIT
+27 KILL ^PSOARC(DA,0)
End DoDot:1
+28 KILL ^PSOARC("B"),^PSOARC("C")
+29 KILL DA,DIK
+30 QUIT
