- 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
