Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOLMPAT

PSOLMPAT.m

Go to the documentation of this file.
  1. 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,753**;DEC 1997;Build 53
  1. ;External reference ^PS(55 supported by DBIA 2228
  1. ;
  1. EN I '$D(PSOPAR) D ^PSOLSET I '$D(PSOPAR) S VALMSG="Site Parameters must be Defined!" G EX
  1. D HLDHDR^PSOLMUTL S DA=DFN,PI=""
  1. I '$P($G(PSOPAR),"^",22),'$D(^XUSEC("PSO ADDRESS UPDATE",+$G(DUZ))) G P55
  1. L +^PS(55,DA):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T D MSG G EX
  1. S PSODFN=DA D UPDATE^PSOBAI S DA=PSODFN
  1. W !
  1. L +^DPT(DA):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T D MSG G EX
  1. S DIE="^DPT(",DR="[PSO OUTPT]"
  1. D FULL^VALM1,^DIE L -^DPT(DA)
  1. P55 ;
  1. N MAIL55BF
  1. S MAIL55BF=$$GET1^DIQ(55,PSODFN,.03,"I")
  1. I '$D(^PS(55,PSODFN)) K DIC S DIC="^PS(55,",DIC(0)="LZ",(X,DINUM)=DFN K DD,DO D FILE^DICN K DIC
  1. 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
  1. S DIE="^PS(55,",DR=".02;.03" W !!?5,">>PHARMACY PATIENT DATA<<",! D ^DIE
  1. D MAIL55(PSODFN,MAIL55BF) ;display prescriptions with deleted exemptions
  1. S DIE="^PS(55,",DR=".05;.04;1;3;40:41.1;106;106.1" D ^DIE
  1. I $D(PSORX("PATIENT STATUS")) D ;468 Update PSORX with the current status
  1. . S PSORX("PATIENT STATUS")=$P($G(^PS(55,DA,"PS")),"^")
  1. . I PSORX("PATIENT STATUS")]"" S PSORX("PATIENT STATUS")=$P($G(^PS(53,PSORX("PATIENT STATUS"),0)),"^")
  1. EX L -^PS(55,DA),-^DPT(DA)
  1. D ^PSOORUT2 S VALMBCK="R"
  1. K DIC,X,Y,DIE,D0,DA,DFN,PI,DR,%,%Y,%X,C,DI,DIPGM,DQ,PSOFROM
  1. Q
  1. MSG S VALMSG="Patient Data is Being Edited by Another User!" Q
  1. PLST ;PREGNANCY & LACTATION STATUS DISPLAY
  1. N PSOVAL,PSOHSTYPE,PSOTYPE
  1. S PSOVAL=$G(^TMP("PSOHDR",$J,14,0))
  1. I PSOVAL="" D Q
  1. .W !!,"This patient is not pregnant and is not lactating."
  1. .D WAIT^VALM1
  1. K ^TMP("DIERR",$J)
  1. S PSOTYPE("P")="VA-WH PREGNANCY STATUS",PSOTYPE("L")="VA-WH LACTATION STATUS"
  1. S PSOTYPE("PL")="VA-WH PREG & LAC STATUS",PSOTYPE("LP")=PSOTYPE("PL")
  1. I $D(PSOTYPE(PSOVAL)) D
  1. .S PSOHSTYPE=$$FIND1^DIC(142,,"X",PSOTYPE(PSOVAL))
  1. .I +PSOHSTYPE=0 D Q
  1. ..W !!,"Could not find the "_PSOTYPE(PSOTYPE)_" health summary type."
  1. ..I $D(^TMP("DIERR",$J)) W ! D MSG^DIALOG() K ^TMP("DIERR",$J)
  1. ..D WAIT^VALM1
  1. .D ENX^GMTSDVR(PSODFN,PSOHSTYPE)
  1. Q
  1. ;
  1. MAIL55(PSODFN,MAIL55BF) ;entry for mail exemption delete
  1. ;called from the screen of the PHARMACY PATIENT file (#55), MAIL field (#.03)
  1. ;PSODFN - Patient IEN
  1. ;MAIL55BF - Old value of the PHARMACY PATIENT file (#55) field MAIL (#.03)
  1. I '$D(PSODFN) Q
  1. N RXIEN,STA,DRUG,X1,X2,PSODTCUT,MAIL55EX,MAIL55AF,FLG,X,Y,%E
  1. S MAIL55AF=$$GET1^DIQ(55,PSODFN,.03,"I")
  1. I MAIL55BF=MAIL55AF Q
  1. S FLG=0
  1. S X2=-120,X1=DT D C^%DTC S PSODTCUT=X ;date cutoff for prescriptions
  1. S MAIL55EX=$S(MAIL55AF="":"REGULAR MAIL",MAIL55AF=0:"REGULAR MAIL",MAIL55AF=1:"CERTIFIED MAIL",MAIL55AF=2:"DO NOT MAIL",MAIL55AF=3:"LOCAL - REGULAR",MAIL55AF=4:"LOCAL - CERTIFIED",1:"")
  1. S STA="" F S STA=$O(PSOSD(STA)) Q:STA="" I "^ACTIVE^NON-VERIFIED^REFILL^HOLD^DRUG INTERACTIONS^SUSPENDED^"[STA D
  1. .S DRUG="" F S DRUG=$O(PSOSD(STA,DRUG)) Q:DRUG="" D
  1. ..S RXIEN=+PSOSD(STA,DRUG)
  1. ..I $$GET1^DIQ(52,RXIEN,100.2)']"" Q
  1. ..I FLG=0 D S FLG=1
  1. ...D FULL^VALM1
  1. ...W !!,"The patient-level MAIL preference has been changed to "_$S(MAIL55EX="":"NULL",1:MAIL55EX)_"."
  1. ...W !,"Exemptions set on the following prescriptions will be removed."
  1. ...W !,"Edit these prescriptions to reinstate the exemptions if necessary."
  1. ...W !
  1. ..W !," ",$$GET1^DIQ(52,RXIEN,.01),?16,$$GET1^DIQ(52,RXIEN,6),?60,$$GET1^DIQ(52,RXIEN,100.2)
  1. ..S FDA(52,RXIEN_",",100.2)="" D FILE^DIE(,"FDA","MSG") ;delete mail exemption
  1. ..D RXACT^PSOBPSU2(RXIEN,,"Mail Exemption automatically deleted with patient level preference update.","E") ;file activity log
  1. D ^PSOBUILD,BLD^PSOORUT1
  1. W ! K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to Continue"
  1. D ^DIR K DIR,X,Y
  1. Q
  1. ;