PSOPAT.m

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 ---PSOPAT   1461     printed  Apr 09, 2024@21:38:41                                                                                                                                                                                                      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