- 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,753**;DEC 1997;Build 53
- ;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 ;
- N MAIL55BF
- S MAIL55BF=$$GET1^DIQ(55,PSODFN,.03,"I")
- 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
- 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" W !!?5,">>PHARMACY PATIENT DATA<<",! D ^DIE
- D MAIL55(PSODFN,MAIL55BF) ;display prescriptions with deleted exemptions
- S DIE="^PS(55,",DR=".05;.04;1;3;40:41.1;106;106.1" 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
- ;
- MAIL55(PSODFN,MAIL55BF) ;entry for mail exemption delete
- ;called from the screen of the PHARMACY PATIENT file (#55), MAIL field (#.03)
- ;PSODFN - Patient IEN
- ;MAIL55BF - Old value of the PHARMACY PATIENT file (#55) field MAIL (#.03)
- I '$D(PSODFN) Q
- N RXIEN,STA,DRUG,X1,X2,PSODTCUT,MAIL55EX,MAIL55AF,FLG,X,Y,%E
- S MAIL55AF=$$GET1^DIQ(55,PSODFN,.03,"I")
- I MAIL55BF=MAIL55AF Q
- S FLG=0
- S X2=-120,X1=DT D C^%DTC S PSODTCUT=X ;date cutoff for prescriptions
- 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:"")
- S STA="" F S STA=$O(PSOSD(STA)) Q:STA="" I "^ACTIVE^NON-VERIFIED^REFILL^HOLD^DRUG INTERACTIONS^SUSPENDED^"[STA D
- .S DRUG="" F S DRUG=$O(PSOSD(STA,DRUG)) Q:DRUG="" D
- ..S RXIEN=+PSOSD(STA,DRUG)
- ..I $$GET1^DIQ(52,RXIEN,100.2)']"" Q
- ..I FLG=0 D S FLG=1
- ...D FULL^VALM1
- ...W !!,"The patient-level MAIL preference has been changed to "_$S(MAIL55EX="":"NULL",1:MAIL55EX)_"."
- ...W !,"Exemptions set on the following prescriptions will be removed."
- ...W !,"Edit these prescriptions to reinstate the exemptions if necessary."
- ...W !
- ..W !," ",$$GET1^DIQ(52,RXIEN,.01),?16,$$GET1^DIQ(52,RXIEN,6),?60,$$GET1^DIQ(52,RXIEN,100.2)
- ..S FDA(52,RXIEN_",",100.2)="" D FILE^DIE(,"FDA","MSG") ;delete mail exemption
- ..D RXACT^PSOBPSU2(RXIEN,,"Mail Exemption automatically deleted with patient level preference update.","E") ;file activity log
- D ^PSOBUILD,BLD^PSOORUT1
- W ! K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to Continue"
- D ^DIR K DIR,X,Y
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOLMPAT 3973 printed Feb 18, 2025@23:57:17 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,753**;DEC 1997;Build 53
- +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 ;
- +1 NEW MAIL55BF
- +2 SET MAIL55BF=$$GET1^DIQ(55,PSODFN,.03,"I")
- +3 IF '$DATA(^PS(55,PSODFN))
- KILL DIC
- SET DIC="^PS(55,"
- SET DIC(0)="LZ"
- SET (X,DINUM)=DFN
- KILL DD,DO
- DO FILE^DICN
- KILL DIC
- +4 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
- +5 SET DIE="^PS(55,"
- SET DR=".02;.03"
- WRITE !!?5,">>PHARMACY PATIENT DATA<<",!
- DO ^DIE
- +6 ;display prescriptions with deleted exemptions
- DO MAIL55(PSODFN,MAIL55BF)
- +7 SET DIE="^PS(55,"
- SET DR=".05;.04;1;3;40:41.1;106;106.1"
- DO ^DIE
- +8 ;468 Update PSORX with the current status
- IF $DATA(PSORX("PATIENT STATUS"))
- Begin DoDot:1
- +9 SET PSORX("PATIENT STATUS")=$PIECE($GET(^PS(55,DA,"PS")),"^")
- +10 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)
- +1 DO ^PSOORUT2
- SET VALMBCK="R"
- +2 KILL DIC,X,Y,DIE,D0,DA,DFN,PI,DR,%,%Y,%X,C,DI,DIPGM,DQ,PSOFROM
- +3 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
- +17 ;
- MAIL55(PSODFN,MAIL55BF) ;entry for mail exemption delete
- +1 ;called from the screen of the PHARMACY PATIENT file (#55), MAIL field (#.03)
- +2 ;PSODFN - Patient IEN
- +3 ;MAIL55BF - Old value of the PHARMACY PATIENT file (#55) field MAIL (#.03)
- +4 IF '$DATA(PSODFN)
- QUIT
- +5 NEW RXIEN,STA,DRUG,X1,X2,PSODTCUT,MAIL55EX,MAIL55AF,FLG,X,Y,%E
- +6 SET MAIL55AF=$$GET1^DIQ(55,PSODFN,.03,"I")
- +7 IF MAIL55BF=MAIL55AF
- QUIT
- +8 SET FLG=0
- +9 ;date cutoff for prescriptions
- SET X2=-120
- SET X1=DT
- DO C^%DTC
- SET PSODTCUT=X
- +10 SET MAIL55EX=$SELECT(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:"")
- +11 SET STA=""
- FOR
- SET STA=$ORDER(PSOSD(STA))
- if STA=""
- QUIT
- IF "^ACTIVE^NON-VERIFIED^REFILL^HOLD^DRUG INTERACTIONS^SUSPENDED^"[STA
- Begin DoDot:1
- +12 SET DRUG=""
- FOR
- SET DRUG=$ORDER(PSOSD(STA,DRUG))
- if DRUG=""
- QUIT
- Begin DoDot:2
- +13 SET RXIEN=+PSOSD(STA,DRUG)
- +14 IF $$GET1^DIQ(52,RXIEN,100.2)']""
- QUIT
- +15 IF FLG=0
- Begin DoDot:3
- +16 DO FULL^VALM1
- +17 WRITE !!,"The patient-level MAIL preference has been changed to "_$SELECT(MAIL55EX="":"NULL",1:MAIL55EX)_"."
- +18 WRITE !,"Exemptions set on the following prescriptions will be removed."
- +19 WRITE !,"Edit these prescriptions to reinstate the exemptions if necessary."
- +20 WRITE !
- End DoDot:3
- SET FLG=1
- +21 WRITE !," ",$$GET1^DIQ(52,RXIEN,.01),?16,$$GET1^DIQ(52,RXIEN,6),?60,$$GET1^DIQ(52,RXIEN,100.2)
- +22 ;delete mail exemption
- SET FDA(52,RXIEN_",",100.2)=""
- DO FILE^DIE(,"FDA","MSG")
- +23 ;file activity log
- DO RXACT^PSOBPSU2(RXIEN,,"Mail Exemption automatically deleted with patient level preference update.","E")
- End DoDot:2
- End DoDot:1
- +24 DO ^PSOBUILD
- DO BLD^PSOORUT1
- +25 WRITE !
- KILL DIR
- SET DIR(0)="E"
- SET DIR("?")="Press Return to continue"
- SET DIR("A")="Press Return to Continue"
- +26 DO ^DIR
- KILL DIR,X,Y
- +27 QUIT
- +28 ;