PSOLMPAT ;BIR/SAB - update pharmacy patient data using listman ;Dec 09, 2021@14:00
;;7.0;OUTPATIENT PHARMACY;**15,117,149,233,268,468,622,441**;DEC 1997;Build 208
;External reference ^PS(55 supported by DBIA 2228
;
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=""
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]"
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
S DIE="^PS(55,",DR=".02;.03;.05;.04;1;3;40:41.1;106;106.1" W !!?5,">>PHARMACY PATIENT DATA<<",! D ^DIE
I $D(PSORX("PATIENT STATUS")) D ;468 Update PSORX with the current status
. S PSORX("PATIENT STATUS")=$P($G(^PS(55,DA,"PS")),"^")
. I PSORX("PATIENT STATUS")]"" S PSORX("PATIENT STATUS")=$P($G(^PS(53,PSORX("PATIENT STATUS"),0)),"^")
EX L -^PS(55,DA),-^DPT(DA) D ^PSOORUT2 S VALMBCK="R"
K DIC,X,Y,DIE,D0,DA,DFN,PI,DR,%,%Y,%X,C,DI,DIPGM,DQ,PSOFROM
Q
MSG S VALMSG="Patient Data is Being Edited by Another User!" Q
PLST ;PREGNANCY & LACTATION STATUS DISPLAY
N PSOVAL,PSOHSTYPE,PSOTYPE
S PSOVAL=$G(^TMP("PSOHDR",$J,14,0))
I PSOVAL="" D Q
.W !!,"This patient is not pregnant and is not lactating."
.D WAIT^VALM1
K ^TMP("DIERR",$J)
S PSOTYPE("P")="VA-WH PREGNANCY STATUS",PSOTYPE("L")="VA-WH LACTATION STATUS"
S PSOTYPE("PL")="VA-WH PREG & LAC STATUS",PSOTYPE("LP")=PSOTYPE("PL")
I $D(PSOTYPE(PSOVAL)) D
.S PSOHSTYPE=$$FIND1^DIC(142,,"X",PSOTYPE(PSOVAL))
.I +PSOHSTYPE=0 D Q
..W !!,"Could not find the "_PSOTYPE(PSOTYPE)_" health summary type."
..I $D(^TMP("DIERR",$J)) W ! D MSG^DIALOG() K ^TMP("DIERR",$J)
..D WAIT^VALM1
.D ENX^GMTSDVR(PSODFN,PSOHSTYPE)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOLMPAT 2134 printed Apr 09, 2024@21:37:50 Page 2
PSOLMPAT ;BIR/SAB - update pharmacy patient data using listman ;Dec 09, 2021@14:00
+1 ;;7.0;OUTPATIENT PHARMACY;**15,117,149,233,268,468,622,441**;DEC 1997;Build 208
+2 ;External reference ^PS(55 supported by DBIA 2228
+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 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
GOTO EX
+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
GOTO EX
+7 SET DIE="^DPT("
SET DR="[PSO OUTPT]"
+8 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 SET DIE="^PS(55,"
SET DR=".02;.03;.05;.04;1;3;40:41.1;106;106.1"
WRITE !!?5,">>PHARMACY PATIENT DATA<<",!
DO ^DIE
+3 ;468 Update PSORX with the current status
IF $DATA(PSORX("PATIENT STATUS"))
Begin DoDot:1
+4 SET PSORX("PATIENT STATUS")=$PIECE($GET(^PS(55,DA,"PS")),"^")
+5 IF PSORX("PATIENT STATUS")]""
SET PSORX("PATIENT STATUS")=$PIECE($GET(^PS(53,PSORX("PATIENT STATUS"),0)),"^")
End DoDot:1
EX LOCK -^PS(55,DA),-^DPT(DA)
DO ^PSOORUT2
SET VALMBCK="R"
+1 KILL DIC,X,Y,DIE,D0,DA,DFN,PI,DR,%,%Y,%X,C,DI,DIPGM,DQ,PSOFROM
+2 QUIT
MSG SET VALMSG="Patient Data is Being Edited by Another User!"
QUIT
PLST ;PREGNANCY & LACTATION STATUS DISPLAY
+1 NEW PSOVAL,PSOHSTYPE,PSOTYPE
+2 SET PSOVAL=$GET(^TMP("PSOHDR",$JOB,14,0))
+3 IF PSOVAL=""
Begin DoDot:1
+4 WRITE !!,"This patient is not pregnant and is not lactating."
+5 DO WAIT^VALM1
End DoDot:1
QUIT
+6 KILL ^TMP("DIERR",$JOB)
+7 SET PSOTYPE("P")="VA-WH PREGNANCY STATUS"
SET PSOTYPE("L")="VA-WH LACTATION STATUS"
+8 SET PSOTYPE("PL")="VA-WH PREG & LAC STATUS"
SET PSOTYPE("LP")=PSOTYPE("PL")
+9 IF $DATA(PSOTYPE(PSOVAL))
Begin DoDot:1
+10 SET PSOHSTYPE=$$FIND1^DIC(142,,"X",PSOTYPE(PSOVAL))
+11 IF +PSOHSTYPE=0
Begin DoDot:2
+12 WRITE !!,"Could not find the "_PSOTYPE(PSOTYPE)_" health summary type."
+13 IF $DATA(^TMP("DIERR",$JOB))
WRITE !
DO MSG^DIALOG()
KILL ^TMP("DIERR",$JOB)
+14 DO WAIT^VALM1
End DoDot:2
QUIT
+15 DO ENX^GMTSDVR(PSODFN,PSOHSTYPE)
End DoDot:1
+16 QUIT
