- PSOLMPAT ;BHAM ISC/SAB - update pharmacy patient data using listman ;17-Jun-2013 14:18;DU
- ;;7.0;OUTPATIENT PHARMACY;**15,117,1007,1011,149,233,268,1015**;DEC 1997;Build 62
- ;External reference ^PS(55 supported by DBIA 2228
- ; Modified - IHS/MSC/PLS - 07/11/08 - Line EX+1
- ; IHS/MSC/PLS - 03/28/11 - Line P55+2
- ; IHS/MSC/MGH - 06/12/13 - Line EN+3
- EN I '$D(PSOPAR) D ^PSOLSET I '$D(PSOPAR) S VALMSG="Site Parameters must be Defined!" G EX
- D HLDHDR^PSOLMUTL S DA=DFN,PI=""
- ;IHS/MSC/MGH Commented out section to us old address method
- ;I '$P($G(PSOPAR),"^",22),'$D(^XUSEC("PSO ADDRESS UPDATE",+$G(DUZ))) G P55
- ;L +^PS(55,DA):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T D MSG G EX
- ;S PSODFN=DA D UPDATE^PSOBAI S DA=PSODFN
- ;W !
- L +^DPT(DA):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T D MSG G EX
- ;S DIE="^DPT(",DR="[PSO OUTPT]"
- ;New input parameter
- S DIE="^DPT(",DR="[APSP OUTPT]"
- ;end patch 1015 mods
- D FULL^VALM1,^DIE L -^DPT(DA)
- P55 I '$D(^PS(55,DFN)) K DIC S DIC="^PS(55,",DIC(0)="LZ",(X,DINUM)=DFN K DD,DO D FILE^DICN K DIC
- I $G(DFN),$P($G(^PS(55,DFN,0)),"^")="" S $P(^PS(55,DFN,0),"^")=DFN K DIK S DA=DFN,DIK="^PS(55,",DIK(1)=.01 D EN^DIK K DIK S DA=DFN
- ;IHS/MSC/PLS - 03/28/2011
- ;S DIE="^PS(55,",DR=".02;.03;.05;.04;1;3;40:41.1;106;106.1" W !!?5,">>PHARMACY PATIENT DATA<<",! D ^DIE
- S DIE="^PS(55,",DR=".02;.03;.05;.04;1;3;40:41.1" W !!?5,">>PHARMACY PATIENT DATA<<",! D ^DIE
- EX L -^PS(55,DA),-^DPT(DA) D ^PSOORUT2 S VALMBCK="R"
- ; IHS/MSC/PLS - 07/11/08 - Kill of PSOFROM causing problems with autorelease
- ;K DIC,X,Y,DIE,D0,DA,DFN,PI,DR,%,%Y,%X,C,DI,DIPGM,DQ,PSOFROM
- K DIC,X,Y,DIE,D0,DA,DFN,PI,DR,%,%Y,%X,C,DI,DIPGM,DQ
- Q
- MSG S VALMSG="Patient Data is Being Edited by Another User!" Q
- PSOLMPAT ;BHAM ISC/SAB - update pharmacy patient data using listman ;17-Jun-2013 14:18;DU
- +1 ;;7.0;OUTPATIENT PHARMACY;**15,117,1007,1011,149,233,268,1015**;DEC 1997;Build 62
- +2 ;External reference ^PS(55 supported by DBIA 2228
- +3 ; Modified - IHS/MSC/PLS - 07/11/08 - Line EX+1
- +4 ; IHS/MSC/PLS - 03/28/11 - Line P55+2
- +5 ; IHS/MSC/MGH - 06/12/13 - Line EN+3
- EN IF '$DATA(PSOPAR)
- DO ^PSOLSET
- IF '$DATA(PSOPAR)
- SET VALMSG="Site Parameters must be Defined!"
- GOTO EX
- +1 DO HLDHDR^PSOLMUTL
- SET DA=DFN
- SET PI=""
- +2 ;IHS/MSC/MGH Commented out section to us old address method
- +3 ;I '$P($G(PSOPAR),"^",22),'$D(^XUSEC("PSO ADDRESS UPDATE",+$G(DUZ))) G P55
- +4 ;L +^PS(55,DA):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T D MSG G EX
- +5 ;S PSODFN=DA D UPDATE^PSOBAI S DA=PSODFN
- +6 ;W !
- +7 LOCK +^DPT(DA):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
- IF '$TEST
- DO MSG
- GOTO EX
- +8 ;S DIE="^DPT(",DR="[PSO OUTPT]"
- +9 ;New input parameter
- +10 SET DIE="^DPT("
- SET DR="[APSP OUTPT]"
- +11 ;end patch 1015 mods
- +12 DO FULL^VALM1
- DO ^DIE
- LOCK -^DPT(DA)
- P55 IF '$DATA(^PS(55,DFN))
- KILL DIC
- SET DIC="^PS(55,"
- SET DIC(0)="LZ"
- SET (X,DINUM)=DFN
- KILL DD,DO
- DO FILE^DICN
- KILL DIC
- +1 IF $GET(DFN)
- IF $PIECE($GET(^PS(55,DFN,0)),"^")=""
- SET $PIECE(^PS(55,DFN,0),"^")=DFN
- KILL DIK
- SET DA=DFN
- SET DIK="^PS(55,"
- SET DIK(1)=.01
- DO EN^DIK
- KILL DIK
- SET DA=DFN
- +2 ;IHS/MSC/PLS - 03/28/2011
- +3 ;S DIE="^PS(55,",DR=".02;.03;.05;.04;1;3;40:41.1;106;106.1" W !!?5,">>PHARMACY PATIENT DATA<<",! D ^DIE
- +4 SET DIE="^PS(55,"
- SET DR=".02;.03;.05;.04;1;3;40:41.1"
- WRITE !!?5,">>PHARMACY PATIENT DATA<<",!
- DO ^DIE
- EX LOCK -^PS(55,DA),-^DPT(DA)
- DO ^PSOORUT2
- SET VALMBCK="R"
- +1 ; IHS/MSC/PLS - 07/11/08 - Kill of PSOFROM causing problems with autorelease
- +2 ;K DIC,X,Y,DIE,D0,DA,DFN,PI,DR,%,%Y,%X,C,DI,DIPGM,DQ,PSOFROM
- +3 KILL DIC,X,Y,DIE,D0,DA,DFN,PI,DR,%,%Y,%X,C,DI,DIPGM,DQ
- +4 QUIT
- MSG SET VALMSG="Patient Data is Being Edited by Another User!"
- QUIT
