- PSOPAT ;BHAM ISC/SAB - update pharmacy patient data ;03/08/93 8:35
- ;;7.0;OUTPATIENT PHARMACY;**74,117,149,233,268,326**;DEC 1997;Build 11
- ;Reference to ^PS(55, is supported by IA 2228
- I '$D(PSOPAR) D ^PSOLSET I '$D(PSOPAR) W $C(7),!,"Site Parameters must be Defined!",! G EX
- 2 W ! S PSOFROM=1,DIC("A")="Select Patient: ",DIC(0)="AEQMZ" D EN^PSOPATLK S Y=PSOPTLK G:"^"[Y EX G:Y<0 2 S DFN=+Y S PSOLOUD=1 D:$P($G(^PS(55,DFN,0)),"^",6)'=2 EN^PSOHLUP(DFN) K PSOLOUD
- S DA=DFN,PI="" D ^PSODEM G 2:PI="^"
- 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 D EX G 2
- 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 D EX G 2
- S DIE="^DPT(",DR="[PSO OUTPT]" D ^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 D:$G(DFN)&($P($G(^PS(55,DFN,0)),"^",6)'=2) EN^PSOHLUP(DFN) 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^B" D EN^DIK K DIK S DA=DFN
- S DIE="^PS(55,",DR=".02;.03;.05;.04;1;D ELIG^PSORX1;3;40:41.1;106;106.1" W !!?5,">>PHARMACY PATIENT DATA<<",!
- D ^DIE,EX W !! G 2
- Q
- EX L -^PS(55,+$G(DA)),-^DPT(+$G(DA))
- K DIC,X,Y,DIE,D0,DA,DFN,PI,DR,%,%Y,%X,C,DI,DIPGM,DQ,PSOFROM,PSOPTLK
- Q
- MSG W $C(7),!,"Patient Data is Being Edited by Another User!",! Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOPAT 1461 printed Feb 18, 2025@23:59:03 Page 2
- PSOPAT ;BHAM ISC/SAB - update pharmacy patient data ;03/08/93 8:35
- +1 ;;7.0;OUTPATIENT PHARMACY;**74,117,149,233,268,326**;DEC 1997;Build 11
- +2 ;Reference to ^PS(55, is supported by IA 2228
- +3 IF '$DATA(PSOPAR)
- DO ^PSOLSET
- IF '$DATA(PSOPAR)
- WRITE $CHAR(7),!,"Site Parameters must be Defined!",!
- GOTO EX
- 2 WRITE !
- SET PSOFROM=1
- SET DIC("A")="Select Patient: "
- SET DIC(0)="AEQMZ"
- DO EN^PSOPATLK
- SET Y=PSOPTLK
- if "^"[Y
- GOTO EX
- if Y<0
- GOTO 2
- SET DFN=+Y
- SET PSOLOUD=1
- if $PIECE($GET(^PS(55,DFN,0)),"^",6)'=2
- DO EN^PSOHLUP(DFN)
- KILL PSOLOUD
- +1 SET DA=DFN
- SET PI=""
- DO ^PSODEM
- if PI="^"
- GOTO 2
- +2 IF '$PIECE($GET(PSOPAR),"^",22)
- IF '$DATA(^XUSEC("PSO ADDRESS UPDATE",+$GET(DUZ)))
- GOTO P55
- +3 LOCK +^PS(55,DA):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
- IF '$TEST
- DO MSG
- DO EX
- GOTO 2
- +4 SET PSODFN=DA
- DO UPDATE^PSOBAI
- SET DA=PSODFN
- +5 WRITE !
- +6 LOCK +^DPT(DA):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
- IF '$TEST
- DO MSG
- DO EX
- GOTO 2
- +7 SET DIE="^DPT("
- SET DR="[PSO OUTPT]"
- 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
- if $GET(DFN)&($PIECE($GET(^PS(55,DFN,0)),"^",6)'=2)
- DO EN^PSOHLUP(DFN)
- 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^B"
- DO EN^DIK
- KILL DIK
- SET DA=DFN
- +2 SET DIE="^PS(55,"
- SET DR=".02;.03;.05;.04;1;D ELIG^PSORX1;3;40:41.1;106;106.1"
- WRITE !!?5,">>PHARMACY PATIENT DATA<<",!
- +3 DO ^DIE
- DO EX
- WRITE !!
- GOTO 2
- +4 QUIT
- EX LOCK -^PS(55,+$GET(DA)),-^DPT(+$GET(DA))
- +1 KILL DIC,X,Y,DIE,D0,DA,DFN,PI,DR,%,%Y,%X,C,DI,DIPGM,DQ,PSOFROM,PSOPTLK
- +2 QUIT
- MSG WRITE $CHAR(7),!,"Patient Data is Being Edited by Another User!",!
- QUIT
